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

27128


and update Master that looks like this

27129


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.