M
MarkN
Hello,
I modified Ron De Bruin's workbook splitter macro below so that cells
containing more than 255 characters did not get truncated. Paste values is
used to get rid of links.
My question is this: Is there an accepted method for replacing only external
links with values while still allowing the worksheet functions to remain?
Sub Copy_All_Sheets_To_New_Workbook()
Dim WbMain As Workbook
Dim Wb As Workbook
Dim sh As Worksheet
Dim DateString As String
Dim YearDateString As String
Dim FolderName As String
Application.ScreenUpdating = False
Application.EnableEvents = False
DateString = Format(Now, "yy-mm-dd hh-mm-ss")
YearDateString = Format(Now, "yy")
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
'The line below stops truncation where cell length is greater than
255 characters.
ActiveSheet.Range("A1:AZ1000").Value = sh.Range("A1:AZ1000").Value
Set Wb = ActiveWorkbook
With Wb.Sheets(1)
.UsedRange.Copy
.UsedRange.PasteSpecial xlPasteValues
.Cells(1).Select
Application.CutCopyMode = False
End With
Wb.SaveAs FolderName _
& "\" & "Renewq" & YearDateString & Wb.Sheets(1).Name
& ".xls"
Wb.Close True
End If
Next sh
MsgBox "Look in " & FolderName & " for the files"
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
I modified Ron De Bruin's workbook splitter macro below so that cells
containing more than 255 characters did not get truncated. Paste values is
used to get rid of links.
My question is this: Is there an accepted method for replacing only external
links with values while still allowing the worksheet functions to remain?
Sub Copy_All_Sheets_To_New_Workbook()
Dim WbMain As Workbook
Dim Wb As Workbook
Dim sh As Worksheet
Dim DateString As String
Dim YearDateString As String
Dim FolderName As String
Application.ScreenUpdating = False
Application.EnableEvents = False
DateString = Format(Now, "yy-mm-dd hh-mm-ss")
YearDateString = Format(Now, "yy")
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
'The line below stops truncation where cell length is greater than
255 characters.
ActiveSheet.Range("A1:AZ1000").Value = sh.Range("A1:AZ1000").Value
Set Wb = ActiveWorkbook
With Wb.Sheets(1)
.UsedRange.Copy
.UsedRange.PasteSpecial xlPasteValues
.Cells(1).Select
Application.CutCopyMode = False
End With
Wb.SaveAs FolderName _
& "\" & "Renewq" & YearDateString & Wb.Sheets(1).Name
& ".xls"
Wb.Close True
End If
Next sh
MsgBox "Look in " & FolderName & " for the files"
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub