Looping through Workbooks and Copy a Dynamic range to Master Workbook

Question

I have some tables from Excel that will be updated every month or so, what I am trying to do is to copy and paste those ranges from a "master workbook" to some several sheets. The way this works is I have 20 plus workbooks with those ranges "tables" already there, but I am having to manually open those workbooks then copy and paste the new values from the master workbook and close it.

Sub openwb()

Dim wkbk As Workbook
Dim NewFile As Variant
Dim ws As Worksheet
    Dim rngCopy As Range, aCell As Range, bcell As Range
    Dim strSearch As String
    Dim StrFile As Variant
    Dim wb2 As Excel.Workbook


    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    StrFile = Dir("C:\temp\*.xlsx*")
    Do While Len(StrFile) > 0
    Set wb = Workbooks.Open(StrFile)




'NewFile = Application.GetOpenFilename("microsoft excel files (*.xl*), *.xl*")
'
'If NewFile <> False Then
'Set wkbk = Workbooks.Open(NewFile)

'''**********************


    strSearch = "Descitption"

    Set ws = Worksheets("TestCases")

    With ws
        Set aCell = .Columns(4).Find(What:=strSearch, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            Set bcell = aCell

            If rngCopy Is Nothing Then
                Set rngCopy = .Rows((aCell.Row + 1) & ":" & (aCell.Row + 2))
            Else
                Set rngCopy = Union(rngCopy, .Rows((aCell.Row + 1) & ":" & (aCell.Row + 2)))
            End If

            Do
                Set aCell = .Columns(4).FindNext(After:=aCell)

                If Not aCell Is Nothing Then
                    If aCell.Address = bcell.Address Then Exit Do

                    If rngCopy Is Nothing Then
                        Set rngCopy = .Rows((aCell.Row + 1) & ":" & (aCell.Row + 2))
                    Else
                        Set rngCopy = Union(rngCopy, .Rows((aCell.Row + 1) & ":" & (aCell.Row + 2)))
                    End If
                Else
                    Exit Do
                End If
            Loop
        Else
            MsgBox SearchString & " not Found"
        End If

        '~~> I am pasting to Output sheet. Change as applicable
            Set wb2 = Workbooks.Open("C:\temp\Bulk tool\test1.xlsm")
        If Not rngCopy Is Nothing Then rngCopy.Copy 'paste to another worksheet Sheets("Output").Rows(1)


    End With


'**************************

             ActiveWorkbook.Close SaveChanges:=False
             Application.DisplayAlerts = True
         Application.ScreenUpdating = True
     StrFile = Dir

Loop

End Sub

The range is dynamic, it can change from 2 rows to 20, but to give an example A1:K20 and it will go to the same range to another workbook.

first off let me thank everyone helping me on this. here is what I have so far (see code) when I run it I am getting error 1004 not sure what I changed but it was working fine, also what I am trying to do, is to copy to another worksheet.

score 2 · Answer 1 · answered Jun 20 '19 at 22:02

2

Copying and pasting values in a worksheet uses the Range.Copy and Range.PasteSpecial.

An example code is as follows:

Sub CopyThis()
Dim Sht1 As Worksheet, Sht2 As Worksheet
Set Sht1 = ThisWorkbook.Sheets(1)
Set Sht2 = ThisWorkbook.Sheets(2)
Sht1.Range("A1:D4").Copy
Sht2.Range("A1:D4").PasteSpecial xlPasteAll
End Sub

Alternatively, you can also loop through values. I usually do this out of preference because I often do "If Then" in loops

Sub CopyThis2()
Dim Sht1 As Worksheet, Sht2 As Worksheet
Set Sht1 = ThisWorkbook.Sheets(1)
Set Sht2 = ThisWorkbook.Sheets(2)
Dim i As Long, j As Long
For i = 1 To 4
    For j = 1 To 4
        Sht2.Cells(i, j).Value = Sht1.Cells(i, j).Value
    Next j
Next i
End Sub

answered Jun 20 '19 at 22:02

Parker.R

88
8

Thank you @Parker.R the problem I am having, well not a problem but the challenge is that I do not want to open those workbook manually, in the code I have listed will open those workbook in the background and make the changes I need. so the macros you are suggesting although they are great, unfortunately it wouldn't work. I have more than 2600 workbook and I opening all of them one at the time will take too long. – Spock Jun 20 '19 at 22:19
I don't know how exactly to do that using a simple VBA function in the Excel Program. Alternatively, you could open it using an outside application, have the program edit it, and then close it. Otherwise, your best option I am aware of is what @Mikku suggested. – Parker.R Jun 21 '19 at 01:15

Mikku · Answer 2 · 2019-06-21T02:47:20.057

Perhaps you can do little tricks with coding to make it faster. Like in this Answer below

Looping through files in a Folder

You can Also use Application.Screenupdating = False before the loop & True after the loop, so that your process would be way faster. In the Loop you can put the Code suggested by Parker.R ....

Also, there is no other way to copy data from workbooks without opening them in VBA.All you can do it play with the way files are being opened and closed so that the process becomes faster.

Other than Screenupdating few more properties you can Set As per this Link

Code to loop Using `FSO`

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False


Dim objFSO As Object
Dim objFolder, sfol As Object
Dim objFile As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.getFolder(f_add) ''''f_add is the Address of the folder 

'''' Loop For Files in That Folder
For Each objFile In objFolder.Files
 ''''Your Code
Next

'''' Loop for All the Subfolders in The Folder
For Each sfol In objFolder.subfolders
''' Your Code Here
Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

For the love of god please dont use `DIR` Use `FSO` instead. See https://vbaf1.com/file-directory/vba-loop-through-all-files-in-a-folder/ — alowflyingpig, Jun 21 '19 at 00:46
Nice one mate! `DIR` is like an old dog, on its way out.. `FSO` is so much better to use, cant nest within itself unlike `DIR` — alowflyingpig, Jun 21 '19 at 07:19

Looping through Workbooks and Copy a Dynamic range to Master Workbook

2 Answers2

Code to loop Using FSO

Code to loop Using `FSO`