Loop Through Directory (need help adding a second range)

Question

I am very new to the world of code and VBA - but I am having a lot of fun learning and exploring just how powerful these tools are.

I am working on pulling data from one worksheet and placing it in my "master roadmap" spreadsheet. Just a little background: In the master sheet, I have been inserting data in columns A-S; however, column 'A' is reserved on the worksheet I am pulling data from so this is why the range below is set as Range (B:T). I am scanning columns by B:T; pulling that data and inserting it in columns A:S of my master sheet. However, my boss wants to make a change reserve columns "U' through "AD" on her spreadsheet.

So I would like to have VBA scan through two ranges "B:T" and then "AE:BB" (skipping U:AD) and then plug that information in my "master sheet" into columns "A:AQ."

In short, I am hoping all I have to do is insert a 'second range' in the code below to complete this task. Any help would be greatly appreciated!

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

First things first..might want to remove all the `.Select` and `Selection.` from your code [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba?rq=1) — Profex, Jun 11 '18 at 19:31
Thanks for the recommendation, Bruce. I will study the link you provided and apply to future scripts — Rspktcod, Jun 11 '18 at 20:12

score 0 · Accepted Answer · answered Jun 11 '18 at 20:12

The short answer is, yes, you can just add another range.

Here is the long answer (with a few improvments...):

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

Hi Profex, thanks for the response. I ran the code but am receiving an error on line: eRow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(x1Up).Row + 1 Error reads: Run-time error 1004. App defined or obj defined error I reviewed and pasted the code with your updates below but not sure if I missed something. I appreciate your time. — Rspktcod, Jun 11 '18 at 21:28
It worked when I tested it just now. I think maybe you have a typo... `End(x1Up)` should be `End(xlUp)`? — Profex, Jun 11 '18 at 22:25
That did it! Profex, thank you very much. I appreciate the help! I have much much to learn but am excited about it. — Rspktcod, Jun 11 '18 at 23:03
NP. VBA is old & depreciated...but it's still a great tool to get things done, all these years later. Tip 1...it doesn't matter so much the amount of data you write but the number of calls you make to the Sheet (or database). Tip 2...Try not to access Excel's Front End Properties/Functions, they will slow you down and cause you problems in the end. — Profex, Jun 12 '18 at 00:18

Loop Through Directory (need help adding a second range)

1 Answers1