Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Splitting a workbook
I am using Ron Debruin's code below to split each sheet in a workbook into a
new book. It works well but cells containing more than 255 characters get truncated. I understand that you can get around this by copying a range rather than the whole sheet but I can't get it to work. Any help appreciated. Sub Copy_All_Sheets_To_New_Workbook() Dim WbMain As Workbook Dim Wb As Workbook Dim sh As Worksheet Dim DateString As String Dim FolderName As String Application.ScreenUpdating = False Application.EnableEvents = False DateString = Format(Now, "yy-mm-dd hh-mm-ss") Set WbMain = ThisWorkbook FolderName = WbMain.Path & "\" & Left(WbMain.Name, Len(WbMain.Name) - 4) & " " & DateString MkDir FolderName For Each sh In WbMain.Worksheets If sh.Visible = -1 Then sh.Copy Set Wb = ActiveWorkbook ' Use also this to make values from the formulas With Wb.Sheets(1) .UsedRange.Copy .UsedRange.PasteSpecial xlPasteValues .Cells(1).Select Application.CutCopyMode = False End With Wb.SaveAs FolderName _ & "\" & Wb.Sheets(1).Name & ".xls" Wb.Close False End If Next sh MsgBox "Look in " & FolderName & " for the files" Application.ScreenUpdating = True Application.EnableEvents = True End Sub -- Thanks, MarkN |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Splitting a workbook
Untested...
Sub Copy_All_Sheets_To_New_Workbook() Dim WbMain As Workbook Dim Wb As Workbook Dim sh As Worksheet Dim DateString As String Dim FolderName As String dim newWks as worksheet Application.ScreenUpdating = False Application.EnableEvents = False DateString = Format(Now, "yy-mm-dd hh-mm-ss") Set WbMain = ThisWorkbook FolderName = WbMain.Path & "\" & _ Left(WbMain.Name, Len(WbMain.Name) - 4) & " " & DateString MkDir FolderName For Each sh In WbMain.Worksheets If sh.Visible = -1 Then sh.Copy 'added some stuff here set newwks = activesheet sh.cells.copy _ destination:=newwks.range("a1") Set Wb = newwks.parent 'done with changes ' Use also this to make values from the formulas With Wb.Sheets(1) .UsedRange.Copy .UsedRange.PasteSpecial xlPasteValues .Cells(1).Select Application.CutCopyMode = False End With Wb.SaveAs FolderName _ & "\" & Wb.Sheets(1).Name & ".xls" Wb.Close False End If Next sh MsgBox "Look in " & FolderName & " for the files" Application.ScreenUpdating = True Application.EnableEvents = True End Sub MarkN wrote: I am using Ron Debruin's code below to split each sheet in a workbook into a new book. It works well but cells containing more than 255 characters get truncated. I understand that you can get around this by copying a range rather than the whole sheet but I can't get it to work. Any help appreciated. Sub Copy_All_Sheets_To_New_Workbook() Dim WbMain As Workbook Dim Wb As Workbook Dim sh As Worksheet Dim DateString As String Dim FolderName As String Application.ScreenUpdating = False Application.EnableEvents = False DateString = Format(Now, "yy-mm-dd hh-mm-ss") Set WbMain = ThisWorkbook FolderName = WbMain.Path & "\" & Left(WbMain.Name, Len(WbMain.Name) - 4) & " " & DateString MkDir FolderName For Each sh In WbMain.Worksheets If sh.Visible = -1 Then sh.Copy Set Wb = ActiveWorkbook ' Use also this to make values from the formulas With Wb.Sheets(1) .UsedRange.Copy .UsedRange.PasteSpecial xlPasteValues .Cells(1).Select Application.CutCopyMode = False End With Wb.SaveAs FolderName _ & "\" & Wb.Sheets(1).Name & ".xls" Wb.Close False End If Next sh MsgBox "Look in " & FolderName & " for the files" Application.ScreenUpdating = True Application.EnableEvents = True End Sub -- Thanks, MarkN -- Dave Peterson |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Splitting a workbook
Thanks Dave,
I added the line ActiveSheet.Range("A1:AZ1000").Value = sh.Range("A1:AZ1000").Value to the original code and all was well. -- Thanks again, MarkN "Dave Peterson" wrote: Untested... Sub Copy_All_Sheets_To_New_Workbook() Dim WbMain As Workbook Dim Wb As Workbook Dim sh As Worksheet Dim DateString As String Dim FolderName As String dim newWks as worksheet Application.ScreenUpdating = False Application.EnableEvents = False DateString = Format(Now, "yy-mm-dd hh-mm-ss") Set WbMain = ThisWorkbook FolderName = WbMain.Path & "\" & _ Left(WbMain.Name, Len(WbMain.Name) - 4) & " " & DateString MkDir FolderName For Each sh In WbMain.Worksheets If sh.Visible = -1 Then sh.Copy 'added some stuff here set newwks = activesheet sh.cells.copy _ destination:=newwks.range("a1") Set Wb = newwks.parent 'done with changes ' Use also this to make values from the formulas With Wb.Sheets(1) .UsedRange.Copy .UsedRange.PasteSpecial xlPasteValues .Cells(1).Select Application.CutCopyMode = False End With Wb.SaveAs FolderName _ & "\" & Wb.Sheets(1).Name & ".xls" Wb.Close False End If Next sh MsgBox "Look in " & FolderName & " for the files" Application.ScreenUpdating = True Application.EnableEvents = True End Sub MarkN wrote: I am using Ron Debruin's code below to split each sheet in a workbook into a new book. It works well but cells containing more than 255 characters get truncated. I understand that you can get around this by copying a range rather than the whole sheet but I can't get it to work. Any help appreciated. Sub Copy_All_Sheets_To_New_Workbook() Dim WbMain As Workbook Dim Wb As Workbook Dim sh As Worksheet Dim DateString As String Dim FolderName As String Application.ScreenUpdating = False Application.EnableEvents = False DateString = Format(Now, "yy-mm-dd hh-mm-ss") Set WbMain = ThisWorkbook FolderName = WbMain.Path & "\" & Left(WbMain.Name, Len(WbMain.Name) - 4) & " " & DateString MkDir FolderName For Each sh In WbMain.Worksheets If sh.Visible = -1 Then sh.Copy Set Wb = ActiveWorkbook ' Use also this to make values from the formulas With Wb.Sheets(1) .UsedRange.Copy .UsedRange.PasteSpecial xlPasteValues .Cells(1).Select Application.CutCopyMode = False End With Wb.SaveAs FolderName _ & "\" & Wb.Sheets(1).Name & ".xls" Wb.Close False End If Next sh MsgBox "Look in " & FolderName & " for the files" Application.ScreenUpdating = True Application.EnableEvents = True End Sub -- Thanks, MarkN -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro Assistance (Splitting into new workbook by value) | Excel Discussion (Misc queries) | |||
splitting name | Excel Discussion (Misc queries) | |||
Splitting | New Users to Excel | |||
splitting Last Name, First Name | Excel Discussion (Misc queries) | |||
Splitting Panes | Excel Discussion (Misc queries) |