我试图找到一种方法来解决我的问题,但我做不到。我找到了一个将信息从一个excel文件导入到另一个文件的代码。我使用工作表命名和列编号对其进行了重新处理,但是当我尝试运行它时,它给了我一个错误:“错误 #1004:应用程序定义的或对象定义的错误。宏将停止”。你能帮我吗?
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
先感谢您!