Copy range from multiple worksheet to a single worksheet

Question

Can some one help with a vba code to copy a range from multiple worksheets (52 weeks) into a summary sheet in the same workbook. Range is the same in each worksheet. I want the data to be copied and pasted in 52 columns in the ssummary worksheet, from week1 to week 52.

I have found this code online:

Sub SummurizeSheets()
    Dim ws As Worksheet
    Application.ScreenUpdating = False
    Sheets("Summary").Activate
    For Each ws In Worksheets
        If ws.Name <> "Summary" Then
            ws.Range("F46:O47").Copy
            Worksheets("Summary").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
        End If
    Next ws
End Sub

Sub SummurizeSheets() Dim ws As Worksheet Application.ScreenUpdating = False Sheets("Summary").Activate For Each ws In Worksheets If ws.Name <> "Summary" Then ws.Range("F46:O47").Copy Worksheets("Summary").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues) End If Next ws End Sub — user2211547
Hi, I dont get an error. It works fine but it copies all the range in the worksheet to a single column in the summary sheet. What i want is to copy the range in separate colmn — user2211547

Unknown Unknown · Accepted Answer · 2013-03-26T12:43:32

Try below code .Also set Application.ScreenUpdating = True.

Sub SummurizeSheets()
    Dim ws As Worksheet
    Dim j As Integer, col As Integer

    Application.ScreenUpdating = False

    Sheets("Summary").Activate


    For Each ws In Worksheets
        If ws.Name <> "Summary" Then
            ws.Range("k3:k373").Copy

            col = Worksheets("Summary").Range("IV1").End(xlToLeft).Column + 1
            Worksheets("Summary").Cells(1, col).PasteSpecial xlPasteValues
            Application.CutCopyMode = False

        End If

    Next ws
    Columns(1).Delete
    Range("A1").Activate
    Application.ScreenUpdating = True
End Sub

Copy range from multiple worksheet to a single worksheet

1 Answers