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!

+3


source to share


1 answer


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

      

+2


source







All Articles