通过目录中的excel文件循环并复制到主表单

我有一个包含近1000个.csv文件的文件夹。这些文件中的每一个都包含2列，我只想复制其中一列并将其转置到新的工作簿中。新的工作簿将包含来自每个文件的所有数据。下面的代码是什么，我已经产生：通过目录中的excel文件循环并复制到主表单

Sub AllFiles() 
    Application.EnableCancelKey = xlDisabled 

    Dim folderPath As String 
    Dim Filename As String 
    Dim wb As Workbook 

    folderPath = "J:etc. etc. etc." 'contains folder path 

    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\" 

    Filename = Dir(folderPath & "*.csv") 
    Do While Filename <> "" 
     Application.ScreenUpdating = False 
     Set wb = Workbooks.Open(folderPath & Filename) 

     wb.Range(Range("B1"), Range("B1").End(xlDown)).Select 
     Application.CutCopyMode = False 
     Selection.Copy 
     ActiveWorkbook.Close True 
     Windows("Compiled.xlsm").Activate 
     Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True 

     Filename = Dir 
    Loop 
    Application.ScreenUpdating = True 
End Sub

无论出于何种原因代码不工作，弹出一个框式说：“代码执行已中断。”有一次，我打“调试”下面一行被突出显示：

wb.Range(Range("B1"), Range("B1").End(xlDown)).Select

我不是在所有使用VBA经历，我有麻烦了解决此问题。任何想法，这意味着什么，我可以做什么？

来源

2016-05-03 user6272309

尝试添加一个空白行并重新编译代码。 –

关闭所有的excel文件并重新打开并运行你的宏。让我们看看会发生什么 –

突出显示的行是指运行宏的工作簿上的范围，而不是您打开的工作簿中的范围。试着用这个代替：

wb.Range(wb.Range("B1"), wb.Range("B1").End(xlDown)).Select

不过我建议你完全避免使用Select功能，因为它往往会减慢代码。我修剪循环有点避免使用Select和Activate：

Do While Filename <> "" 
    Application.ScreenUpdating = False 
    Set wb = Workbooks.Open(folderPath & Filename) 
    wb.Range(wb.Cells(1,"B"), wb.Cells(Rows.Count,"B").End(xlUp)).Copy 
    Workbooks("Compiled.xlsm").Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True 
    wb.Close True 
    Filename = Dir 
Loop

来源

2016-05-03 13:30:26 Jordan

一旦你打开文件文件，活动工作簿是刚刚打开的书和活动工作表也被确立。

您的代码主要因为wb而失败。。 （一般来说你可以使用一个表引用代替），但在这种情况下，更换：

wb.Range(Range("B1"), Range("B1").End(xlDown)).Select

有：

Range("B1").End(xlDown)).Select

（你也不必选择以完成复制/粘贴）

来源

2016-05-03 13:40:11

试试以下

Sub AllFiles() 
    Application.EnableCancelKey = xlDisabled 
    Dim folderPath As String 
    Dim Filename As String 
    Dim wb As Workbook 
    folderPath = "c:\work\test\" 'contains folder path 
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\" 
    Filename = Dir(folderPath & "*.xlsx") 
    Do While Filename <> "" 
     Application.ScreenUpdating = False 
     Set wb = Workbooks.Open(folderPath & Filename) 
     Range("B1:B" & Range("B" & Rows.count).End(xlUp).Row).Copy 
     Workbooks("Compiled").Worksheets("Sheet1").Range("A" & Range("A" & Rows.count).End(xlUp).Row + 1).PasteSpecial Transpose:=True 
     Workbooks(Filename).Close True 
     Filename = Dir 
    Loop 
    Application.ScreenUpdating = True 
End Sub

来源

2016-05-03 13:41:30

wb.Range(...)将永远不会工作，因为wb是一个工作簿对象。你需要一个工作表对象。尝试：

Dim ws As Worksheet 
Set ws = wb.Activesheet 
ws.Range(ws.Range("B1"), ws.Range("B1").End(xlDown)).Select

来源

2016-05-03 13:46:21

通过目录中的excel文件循环并复制到主表单

回答

相关问题