我遇到了这个错误:错误1004,对象 _Global的 Range方法失败

编程语言 2026-07-10

我正在编写一段代码,将数据从一个工作簿提取到另一个工作簿。但我遇到了错误

错误1004:对象 _global的 Range方法失败

该错误在调试时出现

"'This will find the last Row of the Tracker sheet

 Range("A2:P2000" & l_Row).Copy.

代码:

Sub Get_Abc_Rates_Collate()
Dim n As Integer
Dim wb As Integer
Dim master As String
Dim Userfile As String
Dim l_Row As Long
Dim l_Dest As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False

master = ThisWorkbook.Name

With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = True
    .Title = "Locate Your Files"
    .Show

  n = .SelectedItems.Count

  For wb = 1 To n
      Path = .SelectedItems(wb)
      Workbooks.Open (Path)

      Userfile = ActiveWorkbook.Name

        For Each Sheet In ActiveWorkbook.Worksheets
           If Sheet.Name = "abc_Collate" Then
               Sheet.Select
               l_Row = Sheets("abc_Collate").Range("A1048576").End(xlUp).Row
'This will find the last Row of the Tracker sheet
            Range("A2:P2000" & l_Row).Copy
'This COde will copy all the Data from Tracker sheet
            Windows(master).Activate
'This code will activate the master file where we will paste our data
               l_Dest = Sheets("abc_Rates_CollateMS").Range("A1048576").End(xlUp).Row + 1
'This code will find the next blank row in the master file
            Sheets("abc_Rates_CollateMS").Range("A" & l_Dest).Select
'This code will find the last non blank cell in the master file
            ActiveSheet.Paste
            Windows(Userfile).Close savechanges:=False
        End If
      Next Sheet
  Next wb

End With

'Sheet4.Range("C1").CurrentRegion.EntireColumn.AutoFit

End Sub

解决方案

该错误是由于一个无效的范围导致的:

"A2:P2000" & l_Row

会创建一个无效的地址。
请将其修正为:

Range("A2:P" & l_Row).Copy

备选方案

从多个文件追加数据

  • 当前的问题已在其他答案中覆盖。
  • 下面是你可以改进的做法。
Option Explicit

Sub GetAbcRatesCollate()
' This will append the data from columns 'A:P' of sheet 'abc_Collate'
' of each selected file to the same columns of sheet 'abc_Rates_CollateMS'
' of this file.

    ' Let the user select the (source) files.

    Dim SelectedFiles As FileDialogSelectedItems

    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Title = "Locate Your Files" ' default is "File Open"
        ' If you know the folder path, set it,
        ' so the dialog doesn't open the default (current) path, e.g.:
        '.InitialFileName = "C:\Test\"
        ' If you don't set the filter(s),
        ' Excel will let you 'open' many types of undesired files, e.g., images!
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xl*" ' xls, xlsx, xlsm, xlsb, ...
        '.Filters.Add "All Files", "*.*"
        .Show
        Set SelectedFiles = .SelectedItems
    End With

    If SelectedFiles.Count = 0 Then
        MsgBox "No file selected!", vbExclamation
        Exit Sub
    End If

    ' Create the destination object references.

    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Sheets("abc_Rates_CollateMS")
    ' Assumes the cell in column 'A' of the last row of data is not empty.
    Dim dcell As Range: Set dcell = dws.Cells(dws.Rows.Count, "A").End(xlUp) _
        .Offset(1)

    ' Process the source files.

    Application.ScreenUpdating = False

    Dim swb As Workbook, sws As Worksheet, srg As Range
    Dim n As Long, RowsCount As Long, FilesCount As Long
    Dim FilePath As String

    For n = 1 To SelectedFiles.Count
        FilePath = SelectedFiles(n)
        ' Attempt to open the workbook (file).
        Set swb = Nothing
        On Error Resume Next
            Set swb = Workbooks.Open(Filename:=FilePath, ReadOnly:=True)
        On Error GoTo 0
        If Not swb Is Nothing Then ' file opened
            ' Attempt to reference the source sheet.
            Set sws = Nothing
            On Error Resume Next
                Set sws = swb.Worksheets("abc_Collate")
            On Error GoTo 0
            If Not sws Is Nothing Then ' worksheet exists
                ' If the sheet is filtered, some rows may not be copied.
                ' On the other hand, this might be the desired behavior.
                ' If it is relevant, you decide.
                'If sws.FilterMode Then sws.ShowAllData
                ' Reference the source range (assumes the cell in column 'A'
                ' of the last row of data is not empty, e.g., if no data
                ' in column 'A', it will copy the undesired "A1:P2").
                Set srg = sws.Range("A2:P" & sws.Cells(sws.Rows.Count, "A") _
                    .End(xlUp).Row)
                ' Copy/paste.
                srg.Copy Destination:=dcell
                ' Reference the next top-left destination cell.
                Set dcell = dcell.Offset(srg.Rows.Count)
                ' Collect the stats (for the message box).
                RowsCount = RowsCount + srg.Rows.Count
                FilesCount = FilesCount + 1
            Else ' worksheet doesn't exist; log this in the Immediate window
                Debug.Print "Sheet not found in " & FilePath
            End If
            ' Close the workbook.
            swb.Close SaveChanges:=False
        Else ' file not opened; log this in the Immediate window (Ctrl+G)
            Debug.Print "Could not open " & FilePath
        End If
    Next n

    Application.ScreenUpdating = True

    ' Inform the user.
    MsgBox "Copied " & RowsCount & " row" & IIf(RowsCount = 1, "", "s") _
       & " from " & FilesCount & " file" & IIf(FilesCount = 1, "", "s") _
       & IIf(FilesCount = 0, "!", "."), _
       IIf(FilesCount = 0, vbExclamation, vbInformation)

End Sub
站内所有文章版权归属LeftHeroAI导航站,无授权禁止任何主体转载、抄袭、复制内容,亦不得私自架设镜像站点。一经侵权,本站将通过法律途径追责。

相关文章