1
votes

my code aims to copy the same range from multiple sheets and paste the data from each sheet into the next empty column in a Combined sheet. My code copies from each sheet correctly, but pastes into the same column and overwrites the preceding paste.

Could someone please point out my error?

Many thanks!

Sub CopyToNextCol()

    Dim Sh As Worksheet
    Dim NextCol As Long

    For Each Sh In ThisWorkbook.Worksheets

        If Sh.Name <> "Master" And Sh.Name <> "Lists" And Sh.Name <> "Combined" Then

          NextCol = Sheets("Combined").Cells(, Columns.Count).End(xlToLeft).Column + 1

          Sh.Range("B2:B44").Copy Sheets("Combined").Cells(, NextCol)

        End If

    Next Sh

End Sub
1
Is cell "B2" populated on each sheet? Also, probably good to be explicit on the row: Cells(, Columns.Count) ----> Cells(1, Columns.Count).BigBen
Thanks @BigBen - that's it! If I include B1 (the column header) it works. My problem now is I am planning to use a different column header in the copied data!cdfj
@cdfj you dont need the header, you were missing the number "1" after "Cells(" so it should work on any sheet with any header. The 1 represents the Row you want to know what last cell to use.Ricardo A

1 Answers

0
votes

Copy Same Ranges From Multiple Worksheets

  • The following example will copy the worksheet names ("I am planning to use a different column header" in the comments) in the first row and each range below it.
  • s - Source, d - Destination.

A Quick Fix

Option Explicit

Sub CopyToNextCol()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("Combined")
    Dim dCell As Range
    Set dCell = dws.Cells(1, dws.Columns.Count).End(xlToLeft).Offset(, 1)
    
    Dim sws As Worksheet
    Dim srg As Range
    
    For Each sws In wb.Worksheets
        Select Case sws.Name
        Case "Master", "Lists", "Combined"
            ' Skip (do nothing)
        Case Else
            Set srg = sws.Range("B2:B44")
            dCell.Value = sws.Name
            srg.Copy dCell.Offset(1)
            Set dCell = dCell.Offset(, 1)
        End Select
    Next sws

    'wb.Save

End Sub