Copy range from sheet overwrites data

Question

I am writing a macro to copy a range from multiple sheets (within the same workbook) to a column in a new sheet in the workbook. I would like values in the range ("C2:C12021") from the first sheet to be copied to column A in the new sheet, then values in the range ("C2:C12021") from the second sheet to column B in the new sheet and so on.

I am currently using the following code however the macro keeps copying the range from each of the sheets I am trying to combine to the same column of the sheet where I am trying to combine them.

As such only the range from the last sheet appears in the combined sheet, I presume this is where the range copied from the other sheets has simply been overwritten as the macro loops through the sheets.

Sub CombineWorksheets()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim CopyRng As Range

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("MergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet named "MergeSheet"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "MergeSheet"

For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> DestSh.Name Then

        'Copy target range
        Set CopyRng = sh.Range("C2:C12021")

         CopyRng.Copy
        With DestSh.Cells(Last + 1, "A")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With

    End If
Next

End Sub

SCB SCB · Accepted Answer · 2014-07-31T13:23:20

You can reference the horizontal values of cells as integers, i.e.

.Cells(Vertical As Integer, Horizontal As Integer)

So at the start of the loop, have a counter variable, and use that in the horizontal value.

Dim count As Integer
For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> DestSh.Name Then

        count = count + 1

        'Copy target range
        Set CopyRng = sh.Range("C2:C12021")

        CopyRng.Copy
        With DestSh.Cells(last + 1, count)
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With

    End If
Next

Copy range from sheet overwrites data

1 Answers