Search code examples
vbaexcelexcel-2007

Get data from specific areas in multiple sheets in selected workbooks


I've to make a macro that allows me to gather data from specific areas, e.g., A1-Ax, and G1-Gx in one sheet and B1-Bx in another sheet and so on, in many different workbooks into one main excel sheet. I've like 5-6 Excel files I have to gather data from and they all contain like 4-5 worksheets.

With the code below, I'm able to gather all the data in each Worksheet, in the selected Workbooks.

But the data I have to gather is from a specific Range which varies per Worksheet and/or Workbook.

My code so far looks like this:

Function LastUsedCell(wks As Excel.Worksheet) As Excel.Range
With wks
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        Set LastUsedCell = .Cells.Find(What:="*", _
            After:=.Range("A1"), _
            Lookat:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False)
    End If
End With
End Function

Function GetNextRowStart(wks As Excel.Worksheet) As Excel.Range
Dim lastCell As Excel.Range
Dim nextRow As Integer
nextRow = 1
Set lastCell = LastUsedCell(wks)
If Not lastCell Is Nothing Then nextRow = lastCell.Row + 1
Set GetNextRowStart = wks.Cells(nextRow, 1)
End Function

Sub Multi()
Dim outputWorkbook As Excel.Workbook
Dim outputWorksheet As Excel.Worksheet
Dim filepath As Variant

Set outputWorkbook = Workbooks.Open("C:\Users\z003k50s\Desktop\Test\Output.xlsx")
Set outputWorksheet = outputWorkbook.Sheets("Sheet1")

For Each filepath In Application.GetOpenFilename(FileFilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
    Dim wkbk As Excel.Workbook
    Dim wks As Excel.Worksheet
    Set wkbk = Workbooks.Open(filepath, , True)
    For Each wks In wkbk.Sheets
        Dim sourceRange As Excel.Range
        Dim outputRange As Excel.Range
        With wks
            Set sourceRange = .Range(.Cells(1, 1), LastUsedCell(wks))
        End With
        Set outputRange = GetNextRowStart(outputWorksheet)
        sourceRange.Copy outputRange
    Next
Next

outputWorksheet.Columns.AutoFit

End Sub

Solution

  • I know it sounds like a lot of work, but just hard code it with copy and paste. It's definitely not the best way to do it, but it'll do the job.