Error # 1004: User-defined or object error. The macro will stop
I tried to find a way to solve my problem, but I could not do it. I found a code to import information from one excel file to another. I reworked it with numbering of sheet and column names, but when I tried to run it, it gave me an error: "Error # 1004: Application-defined or object error. Macro will stop." could you help me?
Private Sub CommandButton1_Click()
On Error GoTo errorhandler
Dim ThisWorkbook As Workbook
Dim ws As Worksheet
Dim RngFleetData, rng As Range
Dim x As Variant
Dim countryN, counnty As String
Dim lReadFirstRow As Long
Dim lReadLastRow As Long
Dim lWriteFirstRow As Long
Dim lWriteLastRow As Long
Dim iRow As Integer
Dim NumOfMonth As Double
filenev = ActiveWorkbook.Name
Application.Calculation = xlCalculationManual
NRRowsRange = 1
x = Application.GetOpenFilename("Excel Spreadsheets ,*.xls*", , "Open File")
If x = False Then
Exit Sub
End If
Set ThisWorkbook = Workbooks.Open(x, False, True)
ThisWorkbook.Worksheets("Sheet1").Unprotect
copied = 0
j = 1
Do While Workbooks(filenev).Sheets("auto").Cells(j, 1) <> "fields extract"
j = j + 1
Loop
j = j + 3
i = 0
Do While ThisWorkbook.Worksheets("Sheet1").Cells(i, 3) <> ""
If ThisWorkbook.Worksheets("Sheet1").Cells(i, 1) <> 0 Then
Workbooks(filenev).Sheets("auto").Cells(j, 1) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 3)
Workbooks(filenev).Sheets("auto").Cells(j, 2) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 12)
Workbooks(filenev).Sheets("auto").Cells(j, 3) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 13)
Workbooks(filenev).Sheets("auto").Cells(j, 4) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 16)
Workbooks(filenev).Sheets("auto").Cells(j, 5) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 19)
Workbooks(filenev).Sheets("auto").Cells(j, 6) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 20)
Workbooks(filenev).Sheets("auto").Cells(j, 7) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 22)
Workbooks(filenev).Sheets("auto").Cells(j, 8) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 23)
Workbooks(filenev).Sheets("auto").Cells(j, 9) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 24)
Workbooks(filenev).Sheets("auto").Cells(j, 10) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 25)
Workbooks(filenev).Sheets("auto").Cells(j, 11) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 26)
Workbooks(filenev).Sheets("auto").Cells(j, 12) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 27)
Workbooks(filenev).Sheets("auto").Cells(j, 13) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 28)
Workbooks(filenev).Sheets("auto").Cells(j, 14) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 32)
Workbooks(filenev).Sheets("auto").Cells(j, 15) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 33)
Workbooks(filenev).Sheets("auto").Cells(j, 16) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 34)
Workbooks(filenev).Sheets("auto").Cells(j, 17) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 35)
Workbooks(filenev).Sheets("auto").Cells(j, 18) = ThisWorkbook.Worksheets("Sheet1").Cells(i, 11)
If ThisWorkbook.Worksheets("Sheet1").Cells(i, 1) = "" Then Workbooks(filenev).Sheets("auto").EntireRow.Delete
If ThisWorkbook.Worksheets("Sheet1").Cells(i, 2) = 0 Then Workbooks(filenev).Sheets("auto").EntireRow.Delete
Application.Goto Workbooks(filenev).Sheets("auto").Cells(j, 1)
ActiveCell.Rows(NRRowsRange).EntireRow.Select
Selection.Copy
Selection.Insert Shift:=xlDown
copied = 1
j = j + 1
End If
i = i + 1
Loop
If copied = 1 Then
ActiveCell.Rows(NRRowsRange).EntireRow.Select
Selection.Delete
Selection.Insert Shift:=xlUp
End If
Application.DisplayAlerts = False
ThisWorkbook.Close False
Application.DisplayAlerts = True
MsgBox "fields has been imported sucessfully!"
Application.Calculation = xlCalculationAutomatic
Workbooks(filenev).Sheets("auto").Activate
errorhandler:
Select Case Err.Number
Case 9
MsgBox "Hey Buddy, this is NOT the right extract! Macro will STOP", vbExclamation, "STOP"
ThisWorkbook.Close False
Case 0
Case Else
MsgBox "Error # " & Err & " : " & Error(Err) & "Macro will STOP"
End Select
End Sub
Thank you in advance!
source to share
I see an error on this line
i = 0
Do While ThisWorkbook.Worksheets("Sheet1").Cells(i, 3) <> ""
The first line cannot be 0
Change i = 0
to i = 1
and try again.
I also see an error on these lines
If ThisWorkbook.Worksheets("Sheet1").Cells(i, 1) = "" Then Workbooks(filenev).Sheets("auto").EntireRow.Delete
If ThisWorkbook.Worksheets("Sheet1").Cells(i, 2) = 0 Then Workbooks(filenev).Sheets("auto").EntireRow.Delete
Which line do you want to remove? You must mention this line. for example
Workbooks(filenev).Sheets("auto").Rows(1).Delete
EDIT
Sorry, but couldn't give this advice. I noticed a few things that I thought I would point out
A . use Option Explicit
This will ensure that you declare all variables. Now why is this important? There are two main reasons for usingOption Explicit
and). This forces you to declare your variables as a specific data type.
b). It keeps a watch on your code checking for a spelling error that can happen when you type a variable.
Can you read this as well ?
B Use the correct treatment. This is necessary so you can catch errors and also not mention "Restore defaults"
For example, you install Application.Calculation = xlCalculationManual
What happens if you get an error? I would recommend something like this
Option Explicit
Private Sub Sample()
Dim clc As Long
On Error GoTo errorhandler
clc = Application.Calculation
Application.Calculation = xlCalculationManual
'
'~~> REST OF YOUR CODE
'
LetsContinue:
Application.Calculation = clc '<~~ Reset Calc
Exit Sub
errorhandler:
Select Case Err.Number
Case 9
MsgBox "Hey Buddy, this is NOT the right extract! Macro will STOP", vbExclamation, "STOP"
ThisWorkbook.Close False
Case Else
MsgBox "Error # " & Err & " : " & Error(Err) & "Macro will STOP"
End Select
Resume LetsContinue
End Sub
source to share