尝试制作一个宏来复制和粘贴从几个 sheet 到一个 sheet 的范围

Question

我正在创建一个宏，我希望能够使用它来复制和粘贴范围从多个作品sheet到一个sheet。我知道我需要复制的范围将从 C3 开始，然后向下复制到最后一行数据。然后我需要将它粘贴到 B6 中主 sheet 的一列中，然后从下一个 sheet（再次从 C3）重复该过程到下一个 C6 列，依此类推到 J 列。

我试过让它工作但运气不好。

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)


Sheets("E0303_0").Range(RngGrp).Copy
ActiveWorkbook.WkSh.Range("A6").Paste

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

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

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

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

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

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

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

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

任何帮助或更好的配置将不胜感激。

Answer 1

您的代码在前两行之后毫无意义。您正在尝试将 sheet 设置为自身 Set DatSh。你想要做的是遍历数组。你的 lastrow 不是行号，而是一个范围，你正试图添加到一个单元格。以下是你要使用的逻辑，你可以根据需要修改。

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

尝试制作一个宏来复制和粘贴从几个 sheet 到一个 sheet 的范围

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

excel

vba

copy-paste

range