Excel 循环目录（需要帮助添加第二个范围）

我对代码和VBA的世界非常陌生，但我在学习和探索这些工具的强大功能方面有很多乐趣

我正在从一个工作表中提取数据，并将其放入我的“主路线图”电子表格中。只是一点背景：在主控表中，我一直在a-S列中插入数据；但是，在我从中提取数据的工作表上保留了列“A”，因此下面的范围被设置为范围（B:T）。我用B:T扫描列；拉取数据并将其插入主控表的A:S列。然而，我的老板想在她的电子表格上通过“广告”来更改保留栏“U”

所以我想让VBA扫描两个范围“B:T”，然后是“AE:BB”（跳过U:AD），然后将这些信息插入我的“母版工作表”中的“A:AQ”列

简而言之，我希望我所要做的就是在下面的代码中插入“第二个范围”来完成这项任务。任何帮助都将不胜感激

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow As Double
Dim lastrow As Double
Dim MasterWorkbook As Workbook
Dim TempWorkbook As Workbook
Dim DirPath As String

    'Clear current data
    Sheet1.Visible = xlSheetVisible
    Sheet2.Visible = xlSheetHidden
    Sheet3.Visible = xlSheetHidden
    Sheet1.Activate

    lastrow = ActiveWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    If lastrow > 1 Then
        Range("A2:AQ" & lastrow).Select
        Selection.Clear
    End If

    DirPath = "C:\Users\rspktcod\Documents\RoadMap Test\Roadmaps\"
    MyFile = Dir(DirPath)
    Set MasterWorkbook = ActiveWorkbook

    Do While Len(MyFile) > 0
        Set TempWorkbook = Workbooks.Open(DirPath & MyFile)
        lastrow = ActiveWorkbook.ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
        Range("B2:T" & lastrow).Copy
        MasterWorkbook.Activate
        erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        ActiveSheet.Paste Destination:=Worksheets("Roadmap").Range(Cells(erow, 1), Cells(erow, 43))
        TempWorkbook.Activate
        Application.CutCopyMode = False
        ActiveWorkbook.Close
        MyFile = Dir
    Loop
End Sub

---

简短的回答是，是，您可以添加另一个范围

下面是一个很长的答案（有一些改进…）：

Sub-LoopThroughDirectory（）
Dim DirPath作为字符串，MyFile作为字符串
“最后一行变暗为长，eRow为长”行应为长
'将主工作簿设置为工作簿
将工作簿设置为工作簿
将工作表设置为工作表
“清除当前数据
Sheet1.Visible=xlSheetVisible
Sheet2.可见=xlSheetHidden
Sheet3.可见=xlSheetHidden
'添加DestSheet以使其更清晰，因为Sheet1特定于此文件。
如果您想将代码更改为不同的工作表、不同的文件，它还可以使代码更易于移植。
设置图纸=图纸1
“主工作簿是个好主意，但在这里不是必需的。
“设置主工作簿=此工作簿”活动工作簿
LastRow=DestSheet.Range（“A”&Rows.Count）.End（xlUp）.Row
如果LastRow>1，则范围（“A2:AQ”&LastRow）。清除
DirPath=“C:\Users\rspktcod\Documents\RoadMap Test\RoadMap\”
'添加了“*.xls*”以将其仅限于Excel工作簿
'您不想处理当前和以前的文件夹，这些文件夹显示为“.”&'
MyFile=Dir（DirPath&“*.xls*”）
当Len（MyFile）>0时执行
设置TempWorkbook=Workbooks.Open（DirPath&MyFile）
'使用了[TempWorkbook.ActiveSheet].Rows.Count，而不仅仅是Rows.Count，以使其更直观
然后使用TempWorkbook.ActiveSheet“1”
'Excel 2003-/2007+具有不同的行数，因此请具体说明从哪个工作表获取行
eRow=DestSheet.Cells（DestSheet.Rows.Count，1）。End（xlUp）。Row+1
.Range（“B2:T”和LastRow）。复制目标：=DestSheet.Cells（eRow，1）
.Range（“AE2:BB”和LastRow）。复制目标：=DestSheet.Range（“T”和eRow）
如果结束
TempWorkbook.Close False“添加了SaveSanges=False作为良好度量
MyFile=Dir
以
环
端接头

第一件事。可能要删除所有

。选择
和
选项。
感谢您的推荐，Bruce。我将研究您提供的链接并应用到未来的scriptsHi Profex，感谢您的回复。我运行了代码，但在第行收到错误：eRow=DestSheet.Cells（DestSheet.Rows.Count，1）.End（x1Up）.Row+1错误显示：运行时错误1004.应用程序定义的或obj定义的错误我在下面的更新中查看并粘贴了代码，但不确定是否遗漏了什么。我感谢您的时间。我刚才测试它时它起了作用。我想您可能有一个打字错误…
End（x1Up）
应该是
End（xlUp）
？成功了！Profex，非常感谢你。我非常感谢你的帮助！我有很多东西要学，但我很兴奋。NP.VBA已经过时了，已经贬值了……但多年以后，它仍然是一个很好的工具来完成事情。提示1……你写的数据量并不重要，但你对工作表（或数据库）的调用次数却很重要.Tip 2…尽量不要访问Excel的前端属性/函数，它们会降低您的速度并最终给您带来问题。这是有道理的。感谢您的提示-非常感谢！
Sub LoopThroughDirectory()
Dim DirPath As String, MyFile As String
Dim LastRow As Long, eRow As Long        ' Rows should be Long
'Dim MasterWorkbook As Workbook
Dim TempWorkbook As Workbook
Dim DestSheet As Worksheet

    'Clear current data
    Sheet1.Visible = xlSheetVisible
    Sheet2.Visible = xlSheetHidden
    Sheet3.Visible = xlSheetHidden
    ' Added DestSheet to be more clear, since Sheet1 is specific to this file.
    ' It also make the code more portable, if you want to change it to a different sheet, in a different file.
    Set DestSheet = Sheet1

    ' MasterWorkbook is a good idea, but not required here.
    'Set MasterWorkbook = ThisWorkbook   'ActiveWorkbook
    LastRow = DestSheet.Range("A" & Rows.Count).End(xlUp).Row
    If LastRow > 1 Then Range("A2:AQ" & LastRow).Clear

    DirPath = "C:\Users\rspktcod\Documents\RoadMap Test\Roadmaps\"
    ' Added "*.xls*" to limit it to just Excel Workbooks
    ' You don't want to process the current and previous folders, which come across as "." & ".."
    MyFile = Dir(DirPath & "*.xls*")
    Do While Len(MyFile) > 0
        Set TempWorkbook = Workbooks.Open(DirPath & MyFile)
        ' Used [TempWorkbook.ActiveSheet].Rows.Count, instead of just Rows.Count to be more percise
        With TempWorkbook.ActiveSheet       ' <-- Not a fan of Activesheet here
            LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
            If LastRow > 1 Then
                ' Excel 2003-/2007+ have different number of rows, so be specific about what sheet to get the Rows from
                eRow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Row + 1
                .Range("B2:T" & LastRow).Copy Destination:=DestSheet.Cells(eRow, 1)
                .Range("AE2:BB" & LastRow).Copy Destination:=DestSheet.Range("T" & eRow)
            End If
            TempWorkbook.Close False        ' Added SaveSanges = False for good measure
            MyFile = Dir
        End With
    Loop
End Sub