将范围从一张纸复制到另一张纸并粘贴多次，直到它循环到下一张纸答案

【问题标题】：Copying range from one sheet to another and paste multiple times till it loops to next sheet将范围从一张纸复制到另一张纸并粘贴多次，直到它循环到下一张纸
【发布时间】：2019-01-17 06:24:24
【问题描述】：

我正在尝试从多个工作表中复制单元格 A3、B4 和 C2 以粘贴到主工作表范围 A:C 中。以及从多个工作表到主工作表范围 D:F 的单元格 A8 到 C25。

我拥有的代码将所有单元格复制到主表中所需的目标位置。但是，它会导致 A:C 中的单元格为空，因为 D:F 有多行。参考copyrng4。

目前我有这个复制代码：

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

结果截图

此代码有效，但第一个工作表循环除外。它将值 A1、B1 和 C1 以及 Copyrng4 值复制到 D1:F18 中。它将 A2:C18 中的所有行留空。

有没有办法在主表上将 copyrang4 复制到 D1:F18 时，A1:C1 中的值会被复制到 A2:C18 中？

我正在尝试将 A1:C1 中的值复制到下面的任何空白列，直到循环转到下一张。

【问题讨论】：

试图遵循你在第一段中提到的所有范围让我头疼
我在为所有范围编码时偏头痛，对不起，伙计。所以我要做的就是将 A1:C1 中的值复制到下面的任何空白列，直到循环进入下一张表
现在这更容易理解了:)

标签： excel vba

【解决方案1】：

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

【讨论】：