VBA code to copy data from multiple workbooks to a sheet in a master wb.

Ninja_nutter

New Member
Joined
Mar 1, 2016
Messages
21
Office Version
  1. 365
Platform
  1. Windows
Hi All,
I have 10 workbooks and a Master workbook in a folder, that I have adapted some code, to copy the data from a named sheet "Action Log" in each source wb to the master wb then loop through to the next wb.
On the master wb sheet column "A" needs to show which wb the data came from by copy/pasting the valve of cell "E1" from the source wb.
The problem I cannot solve is how to make the autofill destination range dynamic.
Any assistance with this problem will be greatly appreciated.

VBA Code:
Sub CopyRange()
    Application.ScreenUpdating = False
    
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Dim lRow As Long
    Dim last_row As Long
    Dim my_Range As Range
    
    
    Set wkbDest = ThisWorkbook
    Const strPath As String = "H:\2021 new version\" 'Folder path for all workbooks
    ChDir strPath
    strExtension = Dir("*.xlsm*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            Sheets("Action Log").Select
            Cells(Rows.Count, 2).End(xlUp).Select
            lr = ActiveCell.Offset(0, 0).Select
            Range(ActiveCell, "N8").Copy
            .Sheets("Action Log").Range("B8:N" & Range("A" & Rows.Count).End(xlUp).Row).Copy wkbDest.Sheets("Action Log").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
            .Sheets("Action Log").Range("E1").Copy 'workbook title to be copied to column A of the master workbook for each row of data copied over
            wkbDest.Sheets("Action Log").Activate
            
            lRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
                        ActiveCell.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False ' pastes the value of E1 to the first blank cell in column A
            Application.CutCopyMode = False
            last_row = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
        Set my_Range = ActiveSheet.Range("A8:A" & last_row) 
        Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Select
        Selection.Copy
        Selection.AutoFill Destination:=Range("A8:A" & last_row) 'This is where I cannot workout how to make this range dynamic after the first wb data has been copied. 
        
        
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
This is a non-vba solution that uses Power Query. No coding required. Fast and efficient.

 
Upvote 0
Thanks for the response alansidman, however I have no experience using Power query.
A VBA option is preferable, as I am not the only user for this spreadsheet. The data transfer can be initiated from a command button.
 
Upvote 0
Hi,​
so link at least the zip of some source workbooks and accordingly the expected result workbook on a files host website like Dropbox …​
 
Upvote 0
  • The expected result workbook is empty ‼ o_O

  • Should the original cells formatting be kept within the result worksheet (slower) ?
 
Upvote 0
  • The expected result workbook is empty ‼ o_O

  • Should the original cells formatting be kept within the result worksheet (slower) ?
The "Outstanding Actions" workbook now has an example of the copied data.
The source formatting is not required just the values.
 
Upvote 0
I can't find any logic between the result workbook and the data workbooks …​
 
Upvote 0
I can't find any logic between the result workbook and the data workbooks …​
The results book will finally be filtered by the "RAG Status" column to show all outstanding tasks "expired" or "In progress". The results data is viewed by the Senior Manager.
 
Upvote 0

Forum statistics

Threads
1,214,515
Messages
6,119,973
Members
448,933
Latest member
Bluedbw

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top