循环浏览目录中的excel文件并将其复制到主表单上
我有一个近1000个.csv文件的文件夹。 这些文件中的每一个都包含2列，我只想复制这些列中的一个，并将其转置到新的工作簿上。 新的工作簿将包含来自每个这些文件的所有数据。 以下代码是我所生成的：
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 无论什么原因，代码不起作用，popup一个框说“代码执行已被中断”。 一旦我点击“debugging”，下面一行就会突出显示：
wb.Range(Range("B1"), Range("B1").End(xlDown)).Select
我没有使用VBA的经验，而且在解决这个问题时遇到了麻烦。 任何想法，这意味着什么，我可以做什么？
突出显示的行是指工作簿上运行macros的范围，而不是您打开的工作簿中的范围。 尝试用这个replace：
wb.Range(wb.Range("B1"), wb.Range("B1").End(xlDown)).Select
不过，我build议你避免使用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
一旦打开文件文件，活动工作簿就是刚刚打开的书，活动工作表也被build立。
你的代码主要因为wb而失败。 。 （一般情况下， 您可以使用图纸参考） ，但在这种情况下，请replace：
wb.Range(Range("B1"), Range("B1").End(xlDown)).Select
有：
Range("B1").End(xlDown)).Select
（您也不需要select完成复制/粘贴）
尝试下面
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
wb.Range(...)将永远不会工作，因为wb是一个工作簿对象。 你需要一个Worksheet对象。 尝试：
Dim ws As Worksheet Set ws = wb.Activesheet ws.Range(ws.Range("B1"), ws.Range("B1").End(xlDown)).Select