我遇到了这个错误:错误1004,对象 _Global的 Range方法失败
我正在编写一段代码,将数据从一个工作簿提取到另一个工作簿。但我遇到了错误
错误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导航站,无授权禁止任何主体转载、抄袭、复制内容,亦不得私自架设镜像站点。一经侵权,本站将通过法律途径追责。