Consulting

Results 1 to 12 of 12

Thread: Excel VBA data transfer between workbooks

  1. #1

    Question Excel VBA data transfer between workbooks

    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.

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    1. Record a macro that does what you want and post it here

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

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3

    Question Excel VBA to transfer data from source files to one master file

    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!
    Attached Files Attached Files

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

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

  6. #6
    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

  7. #7
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  8. #8
    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

  9. #9
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

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

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

    Thank you!

    Jeff

  12. #12
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    <blush>

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

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •