Excel VBA data transfer between workbooks

[jbsurfer]

Hello. It would be great if someone can provide the VBA code so I can transfer data and conditional formatting from a source file that has multiple sheets to a master file that has one sheet. The source data will always be in A1:C1 on all the sheets. The Master file has one sheet and a row for each sheet from the source file. For example, sheet 1 (named "Red") in the source file will have data in A1:C1 and the data for Red needs to be transferred to the Master file in the Red row. sheet 2 (named 'Yellow) in the source file will have data in A1:C1 but needs to be transferred to the Yellow row in the master file. Hope this makes sense.

[Paul_Hossler]

1. Record a macro that does what you want and post it here

2. Attach sample workbooks (Master, supporting, whatever)

[jbsurfer]

Paul, thank you for the quick reply. I attached an example source and master file. I would like a VBA program to feed the data and conditional formatting from the source file to the master. The data in the source file will be updated regularly and will need to be updated in the master. I will have multiple source files. I would like to the VBA program to search / loop for the project name from the source file and find it in the master to update that row. Thank you!

[Paul_Hossler]

Here's a concept that you can look at. I saved them all in a single folder, but not necessary, just easier

I just created some dummy Source workbooks, and used a pivot table to display the results

My Source WB is formatted a little differently

Ask questions if you want

Option Explicit


Sub PackData()
    Dim wbMaster As Workbook, wbSource As Workbook
    Dim wsSource As Worksheet, wsAll As Worksheet
    Dim sFileSource As String
    Dim rowMaster As Long, rowSource As Long, colSource As Long
    Dim dataSource As Range
    
    'init
    Set wbMaster = ThisWorkbook
    Application.ScreenUpdating = False
    
    
    
    'delete old Master
    On Error Resume Next
    Application.DisplayAlerts = False
    wbMaster.Worksheets("All Projects").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    'add new master
    wbMaster.Worksheets.Add
    Set wsAll = ActiveSheet
    wsAll.Name = "All Projects"
    
    rowMaster = 1
    
    wsAll.Cells(rowMaster, 1).Value = "Project"
    wsAll.Cells(rowMaster, 2).Value = "Data"
    wsAll.Cells(rowMaster, 3).Value = "Value"
    
    rowMaster = rowMaster + 1
    
    sFileSource = Application.GetOpenFilename("Source Files, *.xlsx")
    
    Do While sFileSource <> "False"
        Workbooks.Open sFileSource
        Set wbSource = ActiveWorkbook
        
        For Each wsSource In wbSource.Worksheets
            Set dataSource = wsSource.Cells(1, 1).CurrentRegion
            
            For rowSource = 2 To dataSource.Rows.Count
                For colSource = 1 To dataSource.Columns.Count
                    If Len(dataSource.Cells(rowSource, colSource).Value) > 0 Then
                        wsAll.Cells(rowMaster, 1).Value = wsSource.Name
                        wsAll.Cells(rowMaster, 2).Value = dataSource.Cells(1, colSource).Value
                        wsAll.Cells(rowMaster, 3).Value = dataSource.Cells(rowSource, colSource).Value
                
                        rowMaster = rowMaster + 1
                    End If
                Next colSource
            Next rowSource
        Next
    
        wbSource.Close False
            
        wbMaster.Activate
            
        sFileSource = Application.GetOpenFilename("Source Files, *.xlsx")
    
    Loop
    
    wsAll.Cells(1, 1).CurrentRegion.Name = "AllProjects"
    
    Worksheets("Summary").PivotTables(1).PivotCache.Refresh
    
    Application.ScreenUpdating = True
        
End Sub

[jbsurfer]

Paul, thank you very much. I really appreciate you help! I will view your solution and let you know if I have questions.

[jbsurfer]

Paul, I am able to successfully run the macro! Thank you very much. It works great!

In my real situation, I have cells A3:AH3 populated in each tab for each project. Can you update the VBA code to take the data from row 3 (for project 1) in the source file and have it in row 2 in the master? Data for project 2 will come from cells A3:AH3 in the source file (Project 2 sheet) and needs to be on row 3 of the master tab. and etc for X projects. The number of project will grow over time... I hope this makes sense. Please let me know.

Jeff

[Paul_Hossler]

Hmmm ...

So you want to take multiple workbooks with multiple sheets that ALL look like this

Capture.JPG


and update Master that looks like this

Capture2.JPG


Replacing a Project line if it exists, or adding it if it doesn't?

I'll look at it in the morning if that's what you want

[jbsurfer]

Paul, that is exactly correct. and some on the cells will have conditional color formatting with dates.

and yes, replacing a Project line if it exists, or adding it if it doesn't?

you are awesome. Thank you very much!

Jeff

[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

[jbsurfer]

Paul, thank you very much! I will review and let you know. Have a great day.

[jbsurfer]

Paul, this is fantastic! You are truly skilled. I appreciate it. I will let you know if I have other questions.

Thank you!

Jeff

[Paul_Hossler]

<blush>

Once the data is in Master, you can add to the macro: sort the data, highlight certain values, format, etc.