2015-03-30 239 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