2015-03-30 285 views
0
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 

第一次打開工作簿。但是,在第二次循環之後它不會。需要幫忙。運行時錯誤1004 while workbook.open方法

+0

刪除'Application.DisplayAlerts = False'直到它有效,您可能會屏蔽Excel幫助您解決問題。特別是因爲你正在使用'Cells()'(沒有前導''指的是當前工作簿),'.Activate'和'.Select'。當你使用這些工作簿時,你可能在錯誤的工作簿上。 – FreeMan 2015-03-30 18:35:33

+0

弗里曼沒有幫助是否有任何其他方式? – 2015-03-30 18:39:28

+0

它顯示任何錯誤消息嗎?您是否一次一行地進行調試,以確保您始終查看正確的表單?在調試過程中遇到其他任何錯誤? – FreeMan 2015-03-30 18:40:22

回答

0

這將擺脫Active*.select引用,所以你不擔心哪個工作表/工作簿是哪個。注意關於行/列順序的註釋,我永遠不會記得我頭頂的第一個 - 你可能不得不切換它們。

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 
+0

此方法不起作用。複製粘貼根本不起作用 – 2015-03-30 21:12:15

+0

「不工作」不會讓我繼續下去。它是否獲得正確的行/列?我是否按照正確的順序得到它們?它是否產生錯誤? – FreeMan 2015-03-31 01:29:10

+0

運行時錯誤438 – 2015-03-31 11:59:58