Trying to make a macro to copy and paste ranges from several sheets to one sheet


I am creating a macro that i want to be able to use to Copy and Paste ranges from several worksheets to one sheet. I know the range that the range i need to copy will start in C3 and then copy down to the last row of data. Then I will need to paste it into a column on the main sheet in B6, then repeat the process from the next sheet (from C3 again) into the next column C6 and so on to column J.

I’ve tried to get this to work with no luck.

Set WkSh = ActiveSheet
Set DatShs = Sheets(Array("E0303_0", "E0304", "E0305", "E0306", "E0307", "E0308", "E0309", "E0310", "E0311_0"))
Set DatSh = Sheets(DatSh)  'I get Run time Error '13' Type mismatch here
Set Lrow = DatSh.Cells(Rows.Count, "C").End(xlUp)
TnD = DatSh.Range("C:B").Find("*", , , , xlByRows, xlPrevious).Row
Set RngGrp = DatSh.Range("TnD", Lrow)


ActiveWorkbook.Sheets("E0304").Range("C3" & Lrow).Copy

ActiveWorkbook.Sheets("E0305").Range("C3" & Lrow).Copy

ActiveWorkbook.Sheets("E0306").Range("C3" & Lrow).Copy

ActiveWorkbook.Sheets("E0307").Range("C3" & Lrow).Copy

ActiveWorkbook.Sheets("E0308").Range("C3" & Lrow).Copy

ActiveWorkbook.Sheets("E0309").Range("C3" & Lrow).Copy

ActiveWorkbook.Sheets("E0310").Range("C3" & Lrow).Copy

ActiveWorkbook.Sheets("E0311_0").Range("C3" & Lrow).Copy

Any help or even a better configuration would be greatly appreciated.


Your code makes no sense after the first 2 lines. You are trying to set a sheet to itself Set DatSh. What you want to do is loop through the array. Your lastrow is not a row number, but a range and you are trying to add to a cell. The following is the logic you want to use, you can modify as needed.

Sub test()

    Dim SheetArray As Variant
    Set SheetArray = Sheets(Array("E0303_0", "E0304", "E0305", "E0306", "E0307", "E0308", "E0309", "E0310", "E0311_0"))
    For i = 1 To SheetArray.Count
        LR = Sheets(i).Cells(Rows.Count, 3).End(xlUp).Row
        Sheets(i).Range(Sheets(i).Cells(3, 3), Sheets(i).Cells(LR, 3)).Copy
        ActiveSheet.Cells(i, 6).Paste
    Next i
End Sub

Answered By – Darrell H

Answer Checked By – Marilyn (AngularFixing Volunteer)

Leave a Reply

Your email address will not be published.