workbook.open方法运行时错误1004

Question

Public Sub test()

Dim wbk As Workbook
Dim Conswbk As Workbook
Dim Temppath As String
Dim PayTemp As String
Dim Path As String
Dim lstactrow As String

Path = "C:\Users\mathew.m.1\Desktop\New folder\"

Application.DisplayAlerts = False

 Set Conswbk = ThisWorkbook

 Conswbk.Worksheets("Consolidate Payments").Activate

 Cells.ClearContents

 Cells.ClearFormats



PayTemp = Dir(Path & "*.*")

'--------------------------------------------
'OPEN EXCEL FILES


Do While PayTemp > ""  'IF NEXT FILE EXISTS THEN


    Set wbk = Workbooks.Open(Path & PayTemp)
     '
    Range("A12:M1000").Select
    Selection.Copy
    Conswbk.Worksheets("Consolidate Payments").Activate
    lstactrow = Conswbk.Worksheets("Consolidate Payments").Cells(Rows.Count, "C").End(xlUp).Row
    Range("B" & lstactrow).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.PasteSpecial (xlPasteAll)

    Conswbk.Worksheets("Consolidate Payments").Range("A" & lstactrow).Select
    Selection.Offset(1, 0).Select
    ActiveCell.Value = PayTemp

    wbk.Close True
    Set wbk = Nothing

    PayTemp = Dir
Loop

MsgBox ("Done!!!")

End Sub

First time the workbook opens. However, after the loop second time it doesn't. Need help.

Answer 1

This will get rid of the Active* and .select references so you're not worried about which worksheet/workbook is which. Note the comment about row/col order, I can never remember off the top of my head which comes first - you may have to switch them.

Public Sub test()

Dim wbk As Workbook 
Dim Conswbk As Workbook 
Dim ConsWS as Worksheet
Dim Temppath As String 
Dim PayTemp As String 
Dim Path As String 
Dim lstactrow As String

Path = "C:\Users\mathew.m.1\Desktop\New folder\"
'Application.DisplayAlerts = False
Set Conswbk = ThisWorkbook
Set ConsWS = Conswbk.Worksheets("Consolidate Payments")
ConsWS.UsedRange.Cells.ClearContents
ConsWS.UsedRange.Cells.ClearFormats

PayTemp = Dir(Path & ".")

'-------------------------------------------- 'OPEN EXCEL FILES
Do While PayTemp > "" 'IF NEXT FILE EXISTS THEN
  Set wbk = Workbooks.Open(Path & PayTemp)
  wbk.Range("A12:M1000").copy
  'Range("A12:M1000").Select
  'Selection.Copy
  'Conswbk.Worksheets("Consolidate Payments").Activate
  lstactrow = ConsWS.Cells(Rows.Count, "C").End(xlUp).Row
  Consws.cells(2,lstactrow+1).paste  'note, may have row/col switched, can never remember
  'Range("B" & lstactrow).Select
  'ActiveCell.Offset(1, 0).Select
  'ActiveCell.PasteSpecial (xlPasteAll)
  consWB.cells(1,lstactrow+1) = PayTemp
  'Conswbk.Worksheets("Consolidate Payments").Range("A" & lstactrow).Select
  'Selection.Offset(1, 0).Select
  'ActiveCell.Value = PayTemp

  wbk.Close True
  Set wbk = Nothing

  PayTemp = Dir

Loop

MsgBox ("Done!!!")
set consws = nothing
set conswbk = nothing

End Sub