Create separate row for each item when merging multiple workbooks

Question

I have several hundred spreadsheets that I would like to combine into a single master sheet. Each spreadsheet contains general description information in several sells, and the

Answer 1

The root of your problem is that you are trying to do too much in a single subroutine. Whenever your subroutines are over 25-40 lines, you should consider extracting functionality into smaller subroutines. In this way, you will be able to test smaller portions of code at a time.

By implementing this strategy, I managed to reduce the OPs original subroutine from 152 lines of code to 5 easy to debug subroutines with 80 lines of code.

1. MergeNT154BatchCards - Main subroutine
2. AddBatchCard - Opens a Workbook and adds new rows of data to a range
3. getDensityTemplate - Creates a new Workbook based off a template
4. getFileList - Gets a list of file from a directory
5. ToggleEvents - Turns off and on events and returns the current Calculation mode

I haven't tested some parts of the code and as @YowE3K stated the headers don't line up. I would think that it will be fairly easy to modify the code to fit the OPs requirement using these smaller blocks of code.

---

Public Sub MergeNT154BatchCards()
    Dim vFiles As Variant, FileFullName As Variant
    Dim NextRow As Range, wb As Workbook
    Dim CalculationMode As XlCalculation
    CalculationMode = ToggleEvents(False, xlCalculationManual)

    vFiles = getFileList("C:\Users\best buy\Downloads\stackoverfow", "*.xls*")
    If UBound(vFiles) = -1 Then
        MsgBox "No files found", vbInformation, ""
        Exit Sub
    End If

    Set wb = getDensityTemplate

    For Each FileFullName In vFiles
        With wb.Worksheets(1)
            'Add Header
            .Range("A1:H1").Value = Array("FileName", "Description", "WaterTemp(C)", "WaterDensity(g/cc)", "PartID", "DryMass(g)", "SuspendedMass(g)", "Density(g/cc)")
            'Target the next empty row
            Set NextRow = .Range("A" & .Rows.Count).End(xlUp).Offset(1)
            AddBatchCard CStr(FileFullName), NextRow
        End With
    Next

    ToggleEvents True, CalculationMode
End Sub

Private Sub AddBatchCard(FileFullName As String, NextRow As Range)
    Dim cell As Range
    Dim x As Long, y As Long
    With Workbooks.Open(FileFullName)
        With .Worksheets(1)
            For Each cell In .Range("A13", .Range("A" & .Rows.Count).End(xlUp)).Value
                'NextRow
                NextRow.Cells(1, 1).Value = .Range("A4").Value
                NextRow.Cells(1, 2).Value = .Range("B4").Value
                NextRow.Cells(1, 3).Value = .Range("A5").Value
                NextRow.Cells(1, 4).Value = .Range("B5").Value
                NextRow.Cells(1, 4).Resize(1, 4).Value = cell.Resize(1, 4).Value
                Set NextRow = NextRow.Offset(1)
            Next
        End With
        .Close SaveChanges:=False
    End With
End Sub

Private Function getDensityTemplate(FilePath As String) As Workbook
    Dim SheetsInNewWorkbook As Integer
    Dim wb As Workbook
    SheetsInNewWorkbook = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1

    Set wb = Workbooks.Add(xlWBATWorksheet)
    wb.Worksheets(1).Name = "Density"
    wb.SaveAs FileName:=FilePath & "DensitySummary" & Format(Now, "yyyy_mm_dd_hh.mm")
    Set getDensityTemplate = wb
End Function

Private Function getFileList(FilePath As String, PatternSearch As String) As Variant
    Dim FileName As String
    If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"

    With CreateObject("System.Collections.ArrayList")
        FileName = Dir(FilePath & PatternSearch)
        Do While FileName <> ""
            .Add FilePath & FileName
            FileName = Dir()
        Loop
        getFileList = .ToArray
    End With
End Function

Private Function ToggleEvents(EnabelEvents As Boolean, CalculationMode As XlCalculation) As XlCalculation
    With Application
        ToggleEvents = .Calculation
        .Calculation = CalculationMode
        .ScreenUpdating = EnabelEvents
        .EnableEvents = EnabelEvents
    End With
End Function