从一个工作表复制到一个工作表时出现错误1004

I get error 1004 with this code below. The objective is to combine about 30 sheets with the same cell value in A1 into one sheet called 'Data'.

我在下面的代码中得到错误1004。目标是将大约30张具有A1中相同单元格值的纸张组合成一张名为“数据”的纸张。

Sub CombineSheets()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    --create data sheet to hold all the data
    Sheets.Add.Name = "Data"
    --define various variables
    Dim WS_Count As Integer
    Dim I As Integer
    Dim lastrow As Long
    --insert header rows
    Sheets("Data").Range("A1") = "Phone"
    Sheets("Data").Range("B1") = "Area"
    Sheets("Data").Range("C1") = "Property"
    Sheets("Data").Range("D1") = "Value"
    --count the number of sheets
    WS_Count = ActiveWorkbook.Worksheets.Count
    --for each sheet with the cell A1 = "Cleaned" add to Data sheet
    For I = 1 To WS_Count
        lastrow = ActiveWorkbook.Sheets("Data").Cells(1048576, 3).End(xlUp).Row
        ActiveWorkbook.Sheets(I).Activate
        If ActiveSheet.Range("A1") = "Cleaned" Then
        --perform copy
            ActiveSheet.UsedRange.Copy _
               Destination:=Worksheets("Data").Range(Cells(lastrow + 1, 1))
    End If
Next I
Application.ScreenUpdating = True
End Sub

What am I doing wrong? I presume it is in the copying step, but I need to use ActiveSheet to perform the function over all the sheets. Any suggestions

我究竟做错了什么?我认为它是在复制步骤中,但我需要使用ActiveSheet在所有工作表上执行该功能。有什么建议么

1 个解决方案

#1

ActiveSheet.UsedRange.Copy _
     Destination:=Worksheets("Data").Range(Cells(lastrow + 1, 1))

should be:

ActiveSheet.UsedRange.Copy _
     Destination:=Worksheets("Data").Cells(lastrow + 1, 1)