Question

我是Excel中VBA公式的新手。

我有一个包含多个工作表的工作簿，需要在同一工作簿的主工作表中复制（仅限值）。问题是我的一张纸上出现错误：

运行时错误1004：
无法粘贴信息，因为复制区域和粘贴区域的大小和形状不同。

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

这是我的代码：

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

由于所有工作表似乎都具有相同的结构，因此您可以遍历工作表名称：

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，可能还需要另外实施错误处理。

主表复制粘贴错误1004

2 个答案: