在同一活动工作簿中从一个工作表复制和粘贴到另一个工作表时出现错误 1004

Posted 2023-05-06

【中文标题】在同一活动工作簿中从一个工作表复制和粘贴到另一个工作表时出现错误 1004

【英文标题】：Error 1004 when copying and pasting from one worksheet to another in the same active workbook

【发布时间】：2019-07-12 05:10:31

【问题描述】：

我是一个 Excel VBA 新手，试图从多个工作表中复制一系列单元格，我想通过找到最后一个空行并将其粘贴到同一工作簿中的另一个工作表上，并将其逐个粘贴到那里工作表。

当我执行我的代码时，我得到一个 1004 错误。我尝试测试我的代码的不同部分，我注意到当我尝试在工作表中选择一个单元格时，我也收到相同的 1004 错误，但现在显示以下“范围类的选择方法中的错误”。

我尝试使用不同的方法在我的工作表中选择此单元格，例如“ThisWorkbook”、“ActiveWorkbook”以及“Sheets”和“Worksheets”，无论出于何种原因，我都会遇到同样的错误。

代码位于模块中，我使用按钮调用此代码的执行。

有趣的是，当我先选择工作表然后选择范围时，我没有遇到这个问题。

像这样：

ThisWorkbook.Sheets(3).Select
ThisWorkbook.Sheets(3).Range("A6").Select

我想了解为什么会这样，这样我就可以避免在我的代码中使用 select。

顺便说一句，英语不是我的母语，以防我没有翻译 Visual Basic 正确显示的错误。

这是我的代码：

Sub ConsolidacionReportes()

Dim Fila As Long   ' to count each row in a for loop
Dim UltimaFila As Integer  ' Used to find the last row of a sheet
Dim Hojas As Integer ' used in a for loop to go through each sheet in the workbook
Dim RangoCeldas As String ' Range of cells
Dim BorrarTotales As Long ' another variable to count rows

For Hojas = 2 To 6

    UltimaFila = Sheets(Hojas).Cells(Sheets(Hojas).Cells.Rows.Count, "C").End(xlUp).Row - 1

    For Fila = UltimaFila To 5 Step -1
        RangoCeldas = "C"
        If Sheets(Hojas).Cells(Fila, "C") = "" Then
            Sheets(Hojas).Rows(Fila).Delete
        End If
    Next

Next

For Hojas = 2 To 6

BorrarTotales = Sheets(Hojas).Cells(5, 3).End(xlDown).Row + 3

     For Fila = BorrarTotales To 5 Step -1
        If Sheets(Hojas).Cells(Fila, "C") = "" Then
            Sheets(Hojas).Rows(Fila).Delete
        End If
    Next

Next

Reporte1.Range("A1:I5").Copy Calculos.Range("A1")

' When trying to select this range I get the error 1004: Error in select method of Range class

ThisWorkbook.Sheets(3).Range("A6").Select

For Hojas = 2 To 6

    UltimaFila = Sheets(Hojas).Cells(5, 1).End(xlDown).Row

    Let RangoCeldas = "A6:" & "B" & UltimaFila

' When executing the code I get another error 1004, this time the description is: Error defined by the application or the object

    Sheets(Hojas).Range(RangoCeldas).Copy Calculos.Cells(Calculos.Cells(5, 3).End(xlDown), 1)

Next

End Sub

【问题讨论】：

您收到错误消息，因为当您尝试选择其中的单元格时，Thisworkbook 中的第三张工作表未激活。

嗨@Peh，感谢您的评论，我真的无法理解这一点，在第一个循环中，在没有激活任何工作表的情况下一切正常，但在那之后，工作表停用，你会好心告诉我为什么？或指向我的资源来了解这一点？我听说应该尽可能避免使用 select 和 activate 。再次感谢您的帮助。

对不起，达伦，我没有在评论中写下你的名字，感谢你的帮助，我不知道我需要激活工作表，但我不知道为什么我复制和粘贴时也会发生这种情况内容从一张纸到另一张...我希望我的 for 循环转到所有工作表，复制内容并将其粘贴到同一工作簿中的另一张工作表。关于如何有效地做到这一点的任何建议？提前感谢您的帮助。

【参考方案1】：

抱歉，时间有点短，所以无法完全检查。这段代码应该让你更接近解决你的问题。

Sub Test()

    Dim wrkSht As Worksheet 'Will hold a reference to the worksheet being copied from.
    Dim Fila As Long
    Dim UltimaFila As Long

    'Cycle through each worksheet, storing a reference in wrkSht.
    For Each wrkSht In ThisWorkbook.Worksheets
        With wrkSht
            'Check the codename of the sheet.
            'If it's the sheet being copied to ignore it, otherwise process it.
            'Not sure what Reporte1 is, but also ignoring it.
            Select Case .CodeName
                Case "Calculos", "Reporte1"
                    'Do nothing.
                Case Else
                    'Delete rows that have a blank column C.
                    'Could use a filter to speed this step up.
                    If UltimaFila >= 5 Then
                        For Fila = UltimaFila To 5 Step -1
                            If .Cells(UltimaFila, 3) = "" Then
                                .Rows(Fila).Delete
                            End If
                        Next Fila
                    End If

                    'Copy the range from wrksht to Calculos
                    .Range(.Cells(1, 1), .Cells(.Rows.Count, 2).End(xlUp)).Copy _
                        Destination:=Calculos.Cells(.Rows.Count, 1).End(xlUp)

            End Select
        End With
    Next wrkSht

End Sub