Run-time error '1004': Method 'Range' of object '_worksheet' failed while merging

Question

Option Explicit

Public Sub Compile_Workbook_Data()

Dim master_wkbk As Workbook: Set master_wkbk = ThisWorkbook
Dim master_sht As Worksheet: Set master_sht = ThisWorkbook.Worksheets("Task Tracking-Internal & Org.")
Dim current_wkbk As Workbook
Dim current_sht As Worksheet
Dim wkbk_list(1 To 3) As String
Dim x As Integer
Dim last_row As Integer
Dim last_col As Integer

wkbk_list(1) = "Sub Project_WorkBook - Core Services.xlsm"
wkbk_list(2) = "Sub Project_WorkBook - ESP2.0.xlsm"
wkbk_list(3) = "Sub Project_WorkBook - P2E.xlsm"

For x = 1 To UBound(wkbk_list)

    Set current_wkbk = Workbooks.Open("D:\Delta Dental\" & wkbk_list(x))               
    Set current_sht = current_wkbk.Worksheets("Task Tracking-Internal & Org.")

    last_row = current_sht.Cells.Find("*", searchorder:=xlByRows, SearchDirection:=xlPrevious).Row
    last_col = current_sht.Cells.Find("*", searchorder:=xlByColumns, SearchDirection:=xlPrevious).Column

    current_sht.Range(Cells(4, 1), Cells(last_row, last_col)).Copy

    last_row = master_sht.Cells.Find("*", searchorder:=xlByRows, SearchDirection:=xlPrevious).Row
    master_sht.Range("A" & last_row + 1).PasteSpecial Paste:=xlPasteValues

    current_wkbk.Close False
Next x

End Sub

Im getting the following error while running the merge code:

Run-time error '1004': Method 'Range' of object '_worksheet' failed

First, fully qualify your Cells with current_sht.Range(current_sht.Cells(4, 1), current_sht.Cells(last_row, last_col)).Copy. Also, what value is last_row ? — Shai Rado

Ralph Ralph · Accepted Answer · 2017-03-28T12:48:34

The following code is your code. Yet, I made it a bit more verbose. This might allow you to tell where the error is:

Option Explicit

Public Sub Compile_Workbook_Data()

Dim master_wkbk As Workbook
Dim master_sht As Worksheet
Dim current_wkbk As Workbook
Dim current_sht As Worksheet
Dim wkbk_list(1 To 3) As String
Dim x As Integer
Dim last_row As Integer
Dim last_col As Integer

Dim bolFound As Boolean
Dim strFilePath As String
Dim strSheetName As String
Dim FSO As New FileSystemObject

Set master_wkbk = ThisWorkbook
strSheetName = "Task Tracking-Internal & Org."
strFilePath = "E:\Delta Dental\"

bolFound = False
For Each master_sht In master_wkbk.Worksheets
    If master_sht.Name = strSheetName Then bolFound = True: Exit For
Next master_sht
If bolFound = False Then MsgBox "Couldn't find the required sheet in this Excel file." & Chr(10) & "Aborting...": Exit Sub

wkbk_list(1) = "Sub Project_WorkBook - Core Services.xlsm"
wkbk_list(2) = "Sub Project_WorkBook - ESP2.0.xlsm"
wkbk_list(3) = "Sub Project_WorkBook - P2E.xlsm"

If Not FSO.DriveExists(Split(strFilePath, "\")(0)) Then MsgBox "Couldn't find the required drive" & Split(strFilePath, "\")(0) & "." & Chr(10) & "Aborting...": Exit Sub
If Not FSO.FolderExists(strFilePath) Then MsgBox "Couldn't find the required folder." & Chr(10) & "Aborting...": Exit Sub

For x = 1 To UBound(wkbk_list)

    If Dir(strFilePath & wkbk_list(x)) = vbNullString Then MsgBox "File " & Chr(10) & "   " & strFilePath & wkbk_list(x) & Chr(10) & "not found." & Chr(10) & "Aborting...": Exit Sub

    Set current_wkbk = Workbooks.Open("D:\Delta Dental\" & wkbk_list(x))

    bolFound = False
    For Each current_sht In current_wkbk.Worksheets
        If current_sht.Name = strSheetName Then bolFound = True: Exit For
    Next current_sht
    If bolFound = False Then MsgBox "Couldn't find the required sheet in the file:" & Chr(10) & "   " & strFilePath & wkbk_list(x) & Chr(10) & "Aborting...": Exit Sub

    last_row = current_sht.Cells.Find("*", searchorder:=xlByRows, SearchDirection:=xlPrevious).Row
    last_col = current_sht.Cells.Find("*", searchorder:=xlByColumns, SearchDirection:=xlPrevious).Column

    current_sht.Range(Cells(4, 1), Cells(last_row, last_col)).Copy

    last_row = master_sht.Cells.Find("*", searchorder:=xlByRows, SearchDirection:=xlPrevious).Row
    master_sht.Range("A" & last_row + 1).PasteSpecial Paste:=xlPasteValues

    current_wkbk.Close False
Next x

End Sub

Note, that the above code requires a reference to the Microsoft Scripting Runtime. Please make sure that you set it before running the code.

Run-time error '1004': Method 'Range' of object '_worksheet' failed while merging

1 Answers