View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
MarkN MarkN is offline
external usenet poster
 
Posts: 104
Default Split all books in a folder

Hello,

I am using a modified version of Ron De Bruin's (shown below) to split a
workbook, create a new workbook for each sheet and then put each newly
created workbook into a new folder.

How can I modify this code to split all books in the current folder, then
perform the same function:

Thanks in advance,

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

'Converts formulas to values.
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

--
Thanks,
MarkN