Excel VBA data transfer between workbooks

[Paul_Hossler]

Try this

Option Explicit


Sub PackData()
    Dim wbMaster As Workbook, wbSource As Workbook
    Dim wsSource As Worksheet, wsMaster As Worksheet
    Dim sFileSource As String
    Dim rowMaster As Long, rowSource As Long, rowProject As Long
    Dim dataSource As Range
    
    'init
    Set wbMaster = ThisWorkbook
    Set wsMaster = wbMaster.Worksheets("All Projects")
    Application.ScreenUpdating = False
    
    sFileSource = Application.GetOpenFilename("Source Files, *.xlsx")
    
    Do While sFileSource <> "False"
        Workbooks.Open sFileSource
        Set wbSource = ActiveWorkbook
        
        For Each wsSource In wbSource.Worksheets
            With wsSource
                Set dataSource = .Cells(2, 1).CurrentRegion
                
                'down Project rows
                For rowSource = 3 To dataSource.Rows.Count + 1
                    
                    'find Project on Master
                    rowProject = 0
                    On Error Resume Next
                    rowProject = Application.WorksheetFunction.Match(.Cells(rowSource, 1).Value, wsMaster.Columns(1), 0)
                    On Error GoTo 0
                    
                    If rowProject = 0 Then  '   must be new one
                        rowProject = wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                    End If
                                        
                    .Cells(rowSource, 1).Resize(1, 34).Copy wsMaster.Cells(rowProject, 1)
                Next rowSource
            End With
        Next
    
        wbSource.Close False
            
        wbMaster.Activate
            
        sFileSource = Application.GetOpenFilename("Source Files, *.xlsx")
    
    Loop
    
    Application.ScreenUpdating = True
        
End Sub