Master sheet 复制粘贴错误1004

Question

我不熟悉 Excel 中的 VBA 公式。

我有一个包含多个 sheet 的工作簿，需要将其复制（仅值）到同一工作簿的主 sheet 中。问题是我的 sheet 之一出现错误：

Runtime error 1004:
The information cannot be pasted because the Copy area and the paste area are not the same size and shape.

我注意到只有当我的 table 中只有一行不是空白时才会出现此错误。

这是我的代码：

Sub MockImportNewData()

Application.ScreenUpdating = False

        Sheets("BLUGI").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("PANT").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("BLUZE").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("PULOVER").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("FUSTE").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("ROCHII").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("GECI").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("GEANTA").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("ACCESORII").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("Master").Select
        Range("A5").Select

        End Sub

Answer 1

这让我无法通读...巩固时间，加上动态的最后一行：

Sub MockImportNewData()
    Dim lr as Long, olr as Long
    Application.ScreenUpdating = False
    With Sheets("BLUGI")
        lr = Sheets("Master").Cells(Sheets("Master").Rows.Count, 1).End(xlUp).Row
        olr = .Cells(4,1).End(xlDown).Row
        .Range("A4:G" & ).Copy
        Sheets("MASTER").Range( Sheets("MASTER").Cells(lr+1, 1), Sheets("MASTER").Cells(lr+olr+1,7)).PasteSpecial Paste:=xlPasteValues
    End With
    With Sheets("PANT")
        lr = Sheets("Master").Cells(Sheets("Master").Rows.Count, 1).End(xlUp).Row
        olr = .Cells(4,1).End(xlDown).Row
        .Range("A4:G" & .Cells(4,1).End(xlDown).Row).Copy
        Sheets("MASTER").Range( Sheets("MASTER").Cells(lr+1, 1), Sheets("MASTER").Cells(lr+olr+1,7)).PasteSpecial Paste:=xlPasteValues            
    End With
    Application.CutCopyMode = False

'Start with the above and work from there
'You may want to find the CONTIGUOUS (that's the real word) range to find the last row
'Any breaks in the contiguous range will break .End(xlDown)

Answer 2

由于所有作品sheet似乎都具有相同的结构，您可以循环遍历sheet 名称：

Option Explicit

Public Sub MockImportNewData()
    Dim SheetNames As Variant
    SheetNames = Array("BLUGI", "PANT", "BLUZE", "PULOVER", "FUSTE", "ROCHII", "GECI", "GEANTA", "ACCESORII")

    Application.ScreenUpdating = False           

    Dim SheetName As Variant
    For Each SheetName In SheetNames
        Dim lr As Long

        With Worksheets(SheetName)
            lr = .Cells(.Rows.Count, 4).End(xlUp).Row 
            If lr < 4 Then
                MsgBox "Nothing to copy in: " & SheetName
                GoTo NextIteration
            End If
            .Range("A4:G" & lr).Copy
        End With

        With Worksheets("Master")
            lr = .Cells(.Rows.Count, 1).End(xlUp).Row
             .Cells(lr + 1, 1).PasteSpecial Paste:=xlPasteValues
        End With

        Application.CutCopyMode = False

NextIteration:
    Next SheetName

    Application.ScreenUpdating = True
End Sub

如果未找到 SheetName，额外实施错误处理可能是个好主意。

Master sheet 复制粘贴错误1004

Master sheet copy-paste error 1004

excel

vba

excel-2010