Copy and automatically save sheets from a workbook to separate workbooks

[gingerbreadgrl]

Hi,

I have a spreadsheet that is downloaded from a data source. I currently have a macro that takes each row and creates a new sheet for the row, renames it, transposes the data, and deletes any empty rows in the new sheet. I would like to automatically save each sheet to a new workbook, with the file name of the workbook being the same as the sheet name in the original workbook. One more thing to note is that the sheet is only created if there is data in the row, so it is conditional, with the exception of the first record, because there will always be at least one. Any insight would be much appreciated!

' Rename sheet that has been exported from PS with the name structure "Client-Onboarding-DATE"


ActiveSheet.Name = "Client Onboarding"


' Create the Summary Report for each client
' Add a new sheet it will automatically be named Sheet 2


Sheets.Add After:=ActiveSheet


' Copy and paste the column headings from Client Onboarding for the 1st record to a new worksheet, transposing the data from row to column


Sheets("Client Onboarding").Range("A1:HW1").Copy


Sheets(2).Range("A1").Select


Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=True


' Copy and paste the 1st record's data from Client Onboarding to a new worksheet, transposing the data from row to column


Sheets("Client Onboarding").Range("A2:HW2").Copy


Sheets(2).Range("B1").Select


Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=True


' Delete any empty rows that do not contain client data from Record 1


On Error Resume Next
Sheets(2).Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0


' Rename sheet to C1's last name and the matter number


ActiveSheet.Name = Sheets("Client Onboarding").Range("T2") & " " & Sheets(2).Range("B1")


' Format the data in Record 1 worksheet to align left and autofit the column width


Sheets(2).Columns("A").HorizontalAlignment = xlLeft
Sheets(2).Columns("A").ColumnWidth = 47
Sheets(2).Columns("A").WrapText = True


Sheets(2).Columns("B").HorizontalAlignment = xlLeft
Sheets(2).Columns("B").ColumnWidth = 47
Sheets(2).Columns("B").WrapText = True

' If there is a 2nd record exported into the workbook, create a summary worksheet for that new record. This includes:
    ' 1. Create a new worksheet.
    ' 2. Rename the worksheet to C1's last name and the matter number.
    ' 3. Transpose the column headings and that particular record's data into the summary worksheet.
    ' 4. Delete any empty rows from the data.
    ' 5. Format data.


If Sheets("Client Onboarding").Range("A3").Value > 0 Then


Sheets.Add After:=ActiveSheet


Sheets("Client Onboarding").Range("A1:HW1").Copy


Sheets(3).Range("A1").Select


Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=True


Sheets("Client Onboarding").Range("A3:HW3").Copy


Sheets(3).Range("B1").Select


Selection.PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=True


On Error Resume Next
Sheets(3).Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0


Sheets(3).Columns("A").HorizontalAlignment = xlLeft
Sheets(3).Columns("A").ColumnWidth = 47
Sheets(3).Columns("A").WrapText = True


Sheets(3).Columns("B").HorizontalAlignment = xlLeft
Sheets(3).Columns("B").ColumnWidth = 47
Sheets(3).Columns("B").WrapText = True
      
ActiveSheet.Name = Sheets("Client Onboarding").Range("T3") & " " & Sheets(3).Range("B1").Value


End If

Thanks!
Gingerbreadgrl

 

[gingerbreadgrl]

We are getting closer! When I ran the macro with the change it worked for the 1st record (which is row 2), but it also took row 1 (which is all the headings) and created a sheet for that too. There were 5 other records that no summary sheets were created for as well...

Thanks for your help!

 

[Fluff]

That suggests that there is no data in column JE. Try

For Each Cl In .Range("A2:JE" & .Range("A" & Rows.Count).End(xlUp).Row)

 

[gingerbreadgrl]

Hi,

That created 7 sheets off of the 1st record (row 2) and the transposed headings (in column A of the summaries) do not correspond with the data from the row (which is now in column B).

 

[Fluff]

I'm sorry, but I don't understand what your saying.
You should get 1 sheet for each row of data & each sheet should have the header from row transposed into col A & an individual row of data transposed into col B.

 

[gingerbreadgrl]

Yep, that is the goal, and that seemed to be working with the first fix, it just took the header row and put it in column A and repeated it in column B and didn't do the rest of the rows (except the 1st record (in the 2nd row). But, everything was in order.

The second fix made things really wonky, it took the 2nd row and created 7 sheets from the data, it did take the header row and transpose it just fine into all 7 sheets, but the data from the 2nd row (1st record) was then applied to each of the 7 sheets in column B randomly and did not correspond with the order from the original spreadsheet at all. For example, Column A has an ID, Column B has a name, Column C has an email. These were randomly put into column B in each of the 7 sheets. None of the other records showed up in the summaries either...

 

[Fluff]

Got it, use

      For Each Cl In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)