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