Question

我有一个包含近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

无论出于何种原因，代码都不起作用，弹出一个框说“＃34;代码执行已中断。”＃34;一旦我点击＆＃34; Debug＆＃34;突出显示以下行：

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

我对VBA没有任何经验，我在解决此问题时遇到问题。关于这意味着什么以及我能做什么的任何想法？

Answer 1

突出显示的行是指工作簿上运行宏的范围，而不是您打开的工作簿中的范围。尝试替换为：

<div>
  <ul>
   <li>
       <input class="xyz">
   </li>
   <li>
       <input class="xyz">
   </li>
  </ul>
</div>

但是我建议你完全避免使用wb.Range(wb.Range("B1"), wb.Range("B1").End(xlDown)).Select函数，因为它往往会减慢代码速度。我稍微修剪了一下循环以避免使用Select和Select：

Activate

Answer 2

打开文件后，活动工作簿就是刚刚打开的书，同时也建立了活动工作表。

您的代码主要因 wb。而失败。 （通常你会使用工作表参考），但在这种情况下，请替换：

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

使用：

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

（您也不需要选择来完成复制/粘贴）

Answer 3

尝试使用以下

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

Answer 4

wb.Range(...)将永远无法工作，因为wb是一个Workbook对象。您需要一个Worksheet对象。尝试：

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

循环遍历目录中的excel文件并复制到主表单上

4 个答案: