Copying range from one sheet to another and paste multiple times till it loops to next sheet

Question

I am trying to copy cells A3, B4 and C2 from multiple sheets to paste in master sheet Range A:C. and cells A8 to C25 from multiple sheets to master sheet range D:F.

The code I have copies all the cells to their desired destination in master sheet. However it results in empty cell in A:C because D:F have multiple rows. Refer to copyrng4.

Currently I have this code for copying:

For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> DestSh.Name And sh.Name <> "Main" And sh.Name <> "Master" Then

        'Find the last row with data on the DestSh
        Last = LastRow(DestSh)

        'Fill in the range that you want to copy
        Set CopyRng1 = sh.Range("A3")
        Set CopyRng2 = sh.Range("B4")
        Set CopyRng3 = sh.Range("C2")
        Set CopyRng4 = sh.Range("A8:C25")

        'Test if there enough rows in the DestSh to copy all the data
        If Last + CopyRng1.Rows.Count > DestSh.Rows.Count Then
            MsgBox "There are not enough rows in the Destsh"
            GoTo ExitTheSub
        End If

        'This example copies values/formats, if you only want to copy the
        'values or want to copy everything look at the example below this macro
        CopyRng1.Copy
        With DestSh.Cells(Last + 1, "A")
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With

        CopyRng2.Copy
        With DestSh.Cells(Last + 1, "B")
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With

        CopyRng3.Copy
        With DestSh.Cells(Last + 1, "C")
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End With   

        CopyRng4.Copy
        With DestSh.Cells(Last + 1, "D")
            .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
        End With

    End If
Next

Screenshot of result

This code works, except for first sheet loop. It copies the value A1, B1 and C1 and Copyrng4 values in D1:F18. It leaves all the rows in A2:C18 blank.

Is there a way when copying copyrang4 to D1:F18 on master sheet, values in A1:C1 get copied over in A2:C18?

I am trying to copy values in A1:C1 to any blank columns underneath till the loop goes to next sheet.

trying to follow all of the ranges you mentioned in the first paragraph made my head hurt — Marcucciboy2
I had migraine while coding for all the ranges, I am sorry mate. So in all what I am trying to do is copy values in A1:C1 to any blank columns underneath till the loop goes to next sheet — Nav kaur

Tim Williams Tim Williams · Accepted Answer · 2018-08-09T17:49:46

For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> DestSh.Name And sh.Name <> "Main" And sh.Name <> "Master" Then

        'Find the last row with data on the DestSh
        Last = LastRow(DestSh)

        'Test if there enough rows in the DestSh to copy all the data
        If Last + CopyRng1.Rows.Count > DestSh.Rows.Count Then
            MsgBox "There are not enough rows in the Destsh"
            GoTo ExitTheSub
        End If

        'fill 3 values down...
        DestSh.Cells(Last + 1, "A").Resize(18, 3).Value = _
            Array(sh.Range("A3").Value, sh.Range("B4").Value, sh.Range("C2").Value)

        sh.Range("A8:C25").Copy
        With DestSh.Cells(Last + 1, "D")
            .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False
        End With

    End If
Next

Copying range from one sheet to another and paste multiple times till it loops to next sheet

1 Answers