Copy Rows from all sheets to new workbook

[helpexcel]

Hi - I'm looking to copy columns A-Z, Rows 20-30 on every sheet in WorkbookA. I want the sheet name put in A5 of WorkbookB, and then A20:Z30 in A6. There would be 2 blank rows and the next sheet name and range would be pasted into WorkbookB and so on. thanks!

 

[jondavis1987]

I think we are missing several bits of information. What are the sheet names? how many sheets are there? what are the sheet names in the book you want posted in. For instance is Sheet 1 of workbook A supposed to be posted in Sheet 1 of workbook B. and Sheet 2 of workbook A to Sheet 2 of workbook B?

 

[helpexcel]

There number of sheets in Workbook A is variable. I want all of the data from the sheets in workbookA copied to sheet1 in workbookB.

 

[jondavis1987]

okay, Sheet 1 A20:Z30 pastes in A6:Z16 of Workbook B. So you want A20:Z30 of Sheet 2 to drop 3 rows pasting a sheet name at A19 and then paste it A20:Z30 at A20?

 

[helpexcel]

Basically i want to copy the data all of the sheets in WorkbookA on to one sheet in WorkbookB.
All of the data on the sheets in WorkbookA in the same place A20:Z30
I would also like to paste the sheet name the data was copied from in a cell above the copied data.
I would like the copied data to start in A5 of sheet1 in WorkbookB.

 

[mumps]

Place this macro in a standard module in WorkBookA and run it from there. Change the workbook name and sheet name to suit your needs. Make sure both workbooks are open.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet, desWS As Worksheet, x As Long: x = 6
    Set desWS = Workbooks("[COLOR="#FF0000"]WorkbookB.xlsx[/COLOR]").Sheets("[COLOR="#FF0000"]Sheet1[/COLOR]")
    For Each ws In Sheets
        LastRow = desWS.Range("A" & desWS.Rows.Count).End(xlUp).Row
        If LastRow < 5 Then
            desWS.Range("A5") = ws.Name
            ws.Range("A20:Z30").Copy desWS.Range("A6")
        Else
            With desWS
                .Cells(.Rows.Count, "A").End(xlUp).Offset(3, 0) = ws.Name
                ws.Range("A20:Z30").Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
            End With
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

 

[helpexcel]

thanks Mumps! I had to change For Each ws In Sheets to For Each ws In ThisWorkbook.Sheets and it works great. I need to play with it a little, because I want the code in WorkbookB.

 

[mumps]

See if this works for you:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet, srcWS As Workbook, desWS As Worksheet
    Set srcWB = Workbooks("WorkbookA.xlsx")
    Set desWS = Sheets("Sheet1")
    For Each ws In srcWB.Sheets
        LastRow = desWS.Range("A" & desWS.Rows.Count).End(xlUp).Row
        If LastRow < 5 Then
            desWS.Range("A5") = ws.Name
            ws.Range("A20:Z30").Copy desWS.Range("A6")
        Else
            With desWS
                .Cells(.Rows.Count, "A").End(xlUp).Offset(3, 0) = ws.Name
                ws.Range("A20:Z30").Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
            End With
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

 

[helpexcel]

brilliant! thank you!

 

[mumps]

You are very welcome.