Hello all,
Courtesty of this forum, I began to use the following code to help me output approximately 30 worksheets, to seperate workbooks. Frequently, some of those workseets contain no data from row A2 and down. I was wondering how could I stop the macros from generating, what are essentially blank workbooks? Row A1 will always have a header row, hence why it would need to identify that row A2 is blank.
This Macro is called from another which runs through a long list of data, copies relevant rows to indiviual workbooks depending on the cell contents, then, eventually outputs that worksheet to a seperate workbook, which is then emailed out to be actioned. Currently I need to manually check for those which are blank and delete them before running an email macro to send them out.
Sub SplitWorkbook()
'Updateby20140612
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "dd mm yyyy")
'FolderName = xWb.Path & "\" & xWb.Name & " " & DateString
FolderName = xWb.Path & "\" & "TBC Chased" & " " & DateString
MkDir FolderName
For Each xWs In xWb.Worksheets
xWs.Copy
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
Select Case xWb.FileFormat
Case 51:
FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If Application.ActiveWorkbook.HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56:
FileExtStr = ".xls": FileFormatNum = 56
Case Else:
FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
Application.ActiveWorkbook.Close False
Next
MsgBox "Files created. You can now open and run the Email Spreadsheet." '& FolderName
Application.ScreenUpdating = True
End Sub