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

第一次打开工作簿。然而，在循环第二次之后它没有。需要帮助。

Answer 1

这将删除Active*和.select引用，因此您不必担心哪个工作表/工作簿。注意关于行/ col顺序的注释，我永远不会记得我头顶的第一个 - 你可能需要切换它们。

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

workbook.open方法运行时错误1004

1 个答案: