I have tried to find a way to resolve my problem, but I couldn't do it. I found a code to import an information from one excel file to another one. I re-worked it with my sheet naming and columns numbering, but when I tried to run it, it gave me an error: "Error #1004: Application-defined or object-defined error. Macro will stop". Could you please help me with it?
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!
I see an error in this line
i = 0
Do While ThisWorkbook.Worksheets("Sheet1").Cells(i, 3) <> ""
The first row cannot be 0
Change i = 0 to i = 1 and try again.
I also see an error in 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 row do you want to delete? You have to mention the row. For example
Workbooks(filenev).Sheets("auto").Rows(1).Delete
Sorry couldn't help but give this advice. I noticed few things which I thought that I'll 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 using Option Explicit
a). It forces you to declare your variables as a specific data type.
b). It keeps a watch on your code checking for spelling mistake that might happen when you type your variable.
You might also want to read this?
B Use proper handling. This is required so that you can trap errors and also not to mention "Restore Defaults"
For example, you are setting Application.Calculation = xlCalculationManual What happens if you get and 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
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With