Vba 循环浏览文件夹中的excel文件，提取列，将它们粘贴到主文件中，中间有一个空列

我最近开始使用VBA，并为自己分配了一个项目，以便掌握其中的诀窍

现在，这个宏应该在所有Excel文件的文件夹中循环。从每个工作簿中提取一个范围，然后将它们粘贴到主工作簿中的每个工作簿旁边，中间有一个空列

我想添加另一个源工作簿，但我的名声不允许这样做

下面的代码是我在过去几周里提出的，但是我可以想象它会更干净

目前，我无法在粘贴的列之间获得空列，并且出于某种原因，最后提取的列被粘贴了两次

你能帮我解决这些问题吗

Sub SelectDataTestLoop2()
    'Dim file location and file name etc.
    Dim FilePath As Variant
    Dim FileName As Variant
    Dim WBcount As Integer
    Dim OtherWB As Workbook
    Dim ThisWB As Workbook
    Dim ThisWS As Worksheet
    Dim WS As Worksheet

    'Sheet in which the data needs to be pasted (SignalCompilationFile)
    Set ThisWB = ActiveWorkbook
    Set ThisWS = ActiveSheet

    'Define file location and file name
    FilePath = "C:\Users\907443\Desktop\VBA Test\FileTestMap\"
    FileName = Dir(FilePath & "*.xls?")

    WScount = 0

    'Loop over all files in a folder, copy/paste data
    While FileName <> ""
        Set OtherWB = Workbooks.Open(FilePath & FileName)

        For Each WS In OtherWB.Worksheets
            Set CopyRange = OtherWB.Worksheets(4).Range("H2:H114")
            Set PasteRange = ThisWS.Cells(21, 14)

            CopyRange.Copy
            PasteRange.Offset(0, WScount).PasteSpecial xlPasteValues

            WScount = WScount + (1 / 7)
        Next WS

        FileName = Dir()
        Set OtherWB = Nothing
    Wend

    ThisWB.Activate
    ThisWS.Activate
    Set ThisWB = Nothing
    Set ThisWS = Nothing
End Sub

Sub-SelectDataTestLoop2（）
'Dim文件位置和文件名等。
变暗文件路径作为变量
变暗文件名作为变量
将WBcount设置为整数
将其他WB设置为工作簿
将此WB设置为工作簿
将此WS设置为工作表
将WS设置为工作表
'需要粘贴数据的工作表（SignalCompilationFile）
设置ThisWB=ActiveWorkbook
设置ThisWS=ActiveSheet
'定义文件位置和文件名
FilePath=“C:\Users\907443\Desktop\VBA测试\FileTestMap\”
FileName=Dir（文件路径和“*.xls？”）
WScount=0
'循环文件夹中的所有文件，复制/粘贴数据
而文件名为“”
设置OtherWB=Workbooks.Open（文件路径和文件名）
对于其他工作表中的每个WS
设置CopyRange=OtherWB.工作表（4）.范围（“H2:H114”）
设置粘贴范围=ThisWS.Cells（21,14）
复制范围，复制
PasteRange.Offset（0，WScount）.PasteSpecial XLPasteValue
WScount=WScount+（1/7）
下一个WS
FileName=Dir（）
设置OtherWB=Nothing
温德
这个WB。激活
激活
设置ThisWB=Nothing
设置ThisWS=Nothing
端接头

我已经对您的代码进行了注释，希望能有所帮助

Option Explicit

Sub SelectDataTestLoop2()
    'Dim file location and file name etc.
    Dim FilePath As String                  'Variant
    Dim FileName As String                  'Variant
    Dim WBcount As Integer
    Dim OtherWB As Workbook
    Dim ThisWB As Workbook
    Dim ThisWS As Worksheet
    Dim WS As Worksheet

    Dim CopyRange As Range                  ' declare all variables
    Dim TargetColumn As Long

    'Sheet in which the data needs to be pasted (SignalCompilationFile)
    Set ThisWB = ActiveWorkbook             ' logically, I expect ThisWorkbook
    Set ThisWS = ActiveSheet

    'Define file location and file name
    FilePath = "C:\Users\907443\Desktop\VBA Test\FileTestMap\"
    FileName = Dir(FilePath & "*.xls?")

'    WScount = 0                             ' the Dim statement sets the value = 0
                                            ' but there is no Dim statment for WScount
                                            ' use "Option Explicit" at the top of your code sheet

    TargetColumn = 2                        ' define the frist column to paste to (2 = "B")
    'Loop over all files in a folder, copy/paste data
    While FileName <> ""
        Set OtherWB = Workbooks.Open(FilePath & FileName)

        For Each WS In OtherWB.Worksheets
            Set CopyRange = OtherWB.Worksheets(4).Range("H2:H114")
'            Set PasteRange = ThisWS.Cells(21, 14)      ' this specifies N21

            CopyRange.Copy
'            PasteRange.Offset(0, WScount).PasteSpecial xlPasteValues
            ' paste to row 2 in Targetcolumn
            ThisWS.Cells(2, TargetColumn).PasteSpecial
            TargetColumn = TargetColumn + 2

'            WScount = WScount + (1 / 7)
            WBcount = WBcount + 1
        Next WS

        FileName = Dir()
        OtherWB.Close SaveChanges:=False    ' close the workbook after you are done with it
'        Set OtherWB = Nothing
    Wend

'    ThisWB.Activate                        ' after all OtherWb are closed
                                            ' this will be the ActiveWorkbook
'    ThisWS.Activate                        ' - ditto -
''    Set ThisWB = Nothing
''    Set ThisWS = Nothing
End Sub

选项显式
子选择DataTestLoop2（）
'Dim文件位置和文件名等。
Dim FilePath作为字符串变量
Dim文件名作为字符串变量
将WBcount设置为整数
将其他WB设置为工作簿
将此WB设置为工作簿
将此WS设置为工作表
将WS设置为工作表
Dim CopyRange作为范围“声明所有变量”
将目标列变暗为长
'需要粘贴数据的工作表（SignalCompilationFile）
逻辑上设置ThisWB=ActiveWorkbook'我希望是ThisWorkbook
设置ThisWS=ActiveSheet
'定义文件位置和文件名
FilePath=“C:\Users\907443\Desktop\VBA测试\FileTestMap\”
FileName=Dir（文件路径和“*.xls？”）
“WScount=0”Dim语句将值设置为0
“但对WScount来说没有暗淡的状态
在代码表顶部使用“Option Explicit”
TargetColumn=2'定义要粘贴到的第一列（2=“B”）
'循环文件夹中的所有文件，复制/粘贴数据
而文件名为“”
设置OtherWB=Workbooks.Open（文件路径和文件名）
对于其他工作表中的每个WS
设置CopyRange=OtherWB.工作表（4）.范围（“H2:H114”）
“Set pasterrange=ThisWS.Cells（21,14）”这指定了N21
复制范围，复制
'PasteRange.Offset（0，WScount）.PasteValue
'粘贴到Targetcolumn中的第2行
ThisWS.Cells（2，TargetColumn）.PasteSpecial
TargetColumn=TargetColumn+2
'WScount=WScount+（1/7）
WBcount=WBcount+1
下一个WS
FileName=Dir（）
OtherWB.Close SaveChanges:=False“完成工作簿后关闭它。”
'Set OtherWB=Nothing
温德
在所有其他WB关闭后“ThisWB.Activate”
'这将是Active工作簿
“ThisWS.Activate”-同上-
“”设置ThisWB=Nothing
“”设置ThisWS=Nothing
端接头

一些注意事项：（1）将

1/7

（一个浮点数

0.142…

）添加到整数计数器

WScount=WScount+（1/7）

有什么意义？你想在这里干什么？（2） 将变量设置为“无”是不必要的，VBA会在

End Sub

上自动执行此操作。（3） 永远不要使用

变体

，除非你知道为什么需要<代码>文件路径和

文件名

应为

字符串

。处理完后，您可能需要关闭

其他WB

OtherWB.Close

@Peh（1）我无法添加我只需要添加一次工作簿中的数据。添加1/7是我的临时解决方案，使宏只粘贴列一次，而不是7次。原始资料包含7个工作表。（2） 这些都是我对VBA缺乏理解的产物。我还没有看到每一段代码的（ir）相关性。（3） 与第（2）部分相同，感谢您提供的信息，这就是我在这里提问的原因。@SkeXyz好的，我仍然不理解您尝试过的

1/7

。但这肯定行不通。但是看看@Variatus answer，它已经清楚地说明了这一点。感谢您提供的详细信息和清理。我无法添加一个工作簿中的数据，它只需要粘贴一次，而不是7次。我试图通过添加“WScount+（1/7）”来纠正它，但这似乎有点离谱。此外，如果我尝试代码，则只会添加文件夹中第一个工作簿中的数据。最后，我想知道为什么您添加了这一部分：“FilePath=“H:\Name Change Test File\”？文件路径“H:\…”是为了我的测试而被遗忘的。我把它拿走了。代码将在所有Excel工作簿@FilePath中循环，并在上打开每个工作簿