循环目录(需要帮助添加第二个范围)

时间:2018-06-11 19:21:12

标签: excel vba

我对代码和VBA世界都很陌生 - 但我学到很多乐趣并探索这些工具的强大功能。

我正在努力从一个工作表中提取数据并将其放入我的主要路线图"电子表格。只是一点背景:在主表中,我一直在A-S列插入数据;然而,专栏' A'在工作表上保留我从中提取数据所以这就是为什么下面的范围被设置为范围(B:T)。我正在通过B:T扫描列;拉出该数据并将其插入我的主表单的A:S列中。但是,我的老板想要更改预留栏目" U'通过" AD"在她的电子表格上。

所以我想让VBA扫描两个范围" B:T"然后" AE:BB" (跳过U:AD)然后将这些信息插入我的"主表"进入专栏#A; 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

1 个答案:

答案 0 :(得分:0)

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

这是一个很长的答案(有一些改进......):

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