VBA copy-paste loop

Question

I am trying to loop through four tabs, copying data from three input tabs and pasting it into the remaining, master, tab. The code should loop through all the column headings on the master tab, find whether the same heading exists in any of input tabs and, if it does, copy and paste the data into the relevant column of the master tab.

At the moment, I have got all the data from the first input tab into the master tab but I am having difficulties getting data from the remaining input tabs to paste below the data from the first input tab.

This is the code as it stands at the moment:

Sub master_sheet_data()

Application.ScreenUpdating = False

'Variables
Dim ws1_xlRange As Range
Dim ws1_xlCell As Range
Dim ws1 As Worksheet

Dim ws2_xlRange As Range
Dim ws2_xlCell As Range
Dim ws2 As Worksheet

Dim ws3_xlRange As Range
Dim ws3_xlCell As Range
Dim ws3 As Worksheet

Dim ws4_xlRange As Range
Dim ws4_xlCell As Range
Dim ws4 As Worksheet

Dim valueToFind As String
Dim lastrow As String
Dim lastrow2 As String
Dim copy_range As String

'Assign variables to specific worksheets/ranges
'These will need to be updated if changes are made to the file.
Set ws1 = ActiveWorkbook.Worksheets("Refined event data - all")
Set ws1_xlRange = ws1.Range("A1:BJ1")

Set ws2 = Worksheets("Refined event data")
Set ws2_xlRange = ws2.Range("A1:BJ1")

Set ws3 = Worksheets("Refined MASH data")
Set ws3_xlRange = ws3.Range("A1:BJ1")

Set ws4 = Worksheets("Raw RHI data - direct referrals")
Set ws4_xlRange = ws4.Range("A1:BJ1")

'Loop through all the column headers in the all data tab
For Each ws1_xlCell In ws1_xlRange
    valueToFind = ws1_xlCell.Value
        'Loop for - Refined event data tab
        'check whether column headers match. If so, paste column from event tab to relevant column in all data tab
        For Each ws2_xlCell In ws2_xlRange
            If ws2_xlCell.Value = valueToFind Then
                ws2_xlCell.EntireColumn.Copy
                ws1_xlCell.PasteSpecial xlPasteValuesAndNumberFormats
            End If
        Next ws2_xlCell
        'Loop for - Refined ID data tab
        'check whether column headers match. If so, paste column from MASH tab to the end of relevant column in all data tab
        For Each ws3_xlCell In ws3_xlRange
            If ws3_xlCell.Value = valueToFind Then
                Range(ws3_xlCell.Address(), ws3_xlCell.End(xlDown).Address()).Copy
                lastrow = ws1.Cells(Rows.Count, ws1_xlCell.Column).End(xlUp).Row + 1
                Cells(ws1_xlCell.Column & lastrow).PasteSpecial xlPasteValuesAndNumberFormats
            End If
        Next ws3_xlCell
        'Loop for - direct date data tab
        'check whether column headers match. If so, paste column from direct J4U tab to the end of relevant column in all data tab
        For Each ws4_xlCell In ws4_xlRange
            If ws4_xlCell.Value = valueToFind Then
                Range(ws4_xlCell.Address(), ws4_xlCell.End(xlDown).Address()).Copy
                lastrow = ws1.Cells(Rows.Count, ws1_xlCell.Column).End(xlUp).Row + 1
                Cells(ws1_xlCell.Column & lastrow).PasteSpecial xlPasteValuesAndNumberFormats
            End If
        Next ws4_xlCell

Next ws1_xlCell
End Sub

At the moment, this section of code:

    For Each ws3_xlCell In ws3_xlRange 
If ws3_xlCell.Value = valueToFind Then 
Range(ws3_xlCell.Address(), ws3_xlCell.End(xlDown).Address()).Copy 
lastrow = ws1.Cells(Rows.Count, ws1_xlCell.Column).End(xlUp).Row + 1
Cells(ws1_xlCell.Column & lastrow).PasteSpecial xlPasteValuesAndNumberFormats 
End If 
Next ws3_xlCell

Seems to be selecting the correct range on the correct sheet and copying it. The lastrow variable seems to be picking up the correct row on the master tab but the data is not pasted. I've tried naming the ranges and using Cells() rather than Range() but neither appeared to work. Any ideas as to how to get the data to paste would be much appreciated. Cheers, Ant

Without tackling your issue at hand, looking at your code brings two things to mind you may want to consider to improve. You should really not loop through all headers to see if there is a match, and also you can loop through your three sheets (certainly if named ws2-4). I'll look into your issue after lunch if it hasn't been solved yet :) — JvdV
– JvdV, Commented Dec 20, 2018 at 11:58
Range(ws3_xlCell.Address(), ws3_xlCell.End(xlDown).Address()).Copy The Range isn't qualified to any particular sheet so it's using whichever one is currently active. — Darren Bartrup-Cook
– Darren Bartrup-Cook, Commented Dec 20, 2018 at 11:59
@DarrenBartrup-Cook would this solve the range qualifier issue? Range(ws3.ws3_xlCell.Address(), ws3.ws3_xlCell.End(xlDown).Address()).Copy I assumed that by specifying cells in a specific sheet, this would 'lock-in' the range even if the sheet wasn't active. — Ant
– Ant, Commented Dec 20, 2018 at 12:04
You'll need to qualify the Range as well. At the moment ws4_xlCell.Address() returns the text address without any sheet qualify - $D$1 for example. So your range is literally Range("$D$1","$D$20").Copy. You can also use the individual cells directly, so: WS4.RANGE(WS4_XLCELL,WS4_XLCELL.End(xlDown)).Copy — Darren Bartrup-Cook
– Darren Bartrup-Cook, Commented Dec 20, 2018 at 13:06

TinMan · Accepted Answer · 2018-12-20 13:10:50Z

2

What I did was make a function that would find the column header and return the data range from from that column.

Sub master_sheet_data()

    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Dim cell As Range, source As Range, target As Range

    With ThisWorkbook.Worksheets("Raw RHI data - direct referrals")
        For Each ws In Worksheets(Array("Refined event data - all", "Refined event data", "Refined MASH data"))
            For Each cell In .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft))
                Set source = getColumnDataBodyRange(ws, cell.Value)
                If Not source Is Nothing Then
                    Set target = cell.Offset(.Rows.Count - 1).End(xlUp).Offset(1)
                    source.Copy
                    target.PasteSpecial xlPasteValuesAndNumberFormats
                End If
            Next
        Next
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Function getColumnDataBodyRange(ws As Worksheet, ColumnHeader As Variant) As Range
    Dim cell As Range
    With ws
        Set cell = .Rows(1).Find(What:=ColumnHeader, After:=.Range("A1"))
        If Not cell Is Nothing Then
            Set getColumnDataBodyRange = .Range(cell.Offset(1), cell.Offset(.Rows.Count - 1).End(xlUp))
        End If
    End With
End Function

edited Dec 20, 2018 at 13:10

answered Dec 20, 2018 at 13:05

TinMan

7,8142 gold badges13 silver badges24 bronze badges

Sign up to request clarification or add additional context in comments.

5 Comments

Darren Bartrup-Cook Over a year ago

You probably don't need Application.ScreenUpdating = False, or at least need to turn it back to True at the end. Otherwise pretty much what I was thinking of. (+1).

TinMan Over a year ago

Application.ScreenUpdating will definitely speed up the code. I didn't turn it back on because you no longer need to. I went ahead and updated my code to turn it back on for backward compatibility. Thanks @DarrenBartrup-Cook

Darren Bartrup-Cook Over a year ago

Didn't know you no longer needed to turn it back on. When did that happen? I'm in two minds about Screenupdating. It depends on whether the sheet you're making changes to is the active one - I ran the code on this page which uses the activesheet - updating screen took 5.210937, not updating screen took 0.46875 so obviously much faster. When I changed it from Activesheet to one that wasn't & left screenupdating on it took 0.484375 so only a little slower.

TinMan Over a year ago

@DarrenBartrup-Cook it makes a lot of sense that Screenupdating would only make a difference when changes are made to the ActiveSheet. IMO, you should still use it, when writing to a worksheet, unless you are just dumping an array of values. My reasoning is that I want my code to run no matter which sheet is active. Thanks for the info, bro.

JvdV Over a year ago

Nice! This makes so much more sense :)

Collectives™ on Stack Overflow

VBA copy-paste loop

1 Answer 1

5 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

5 Comments

Your Answer

Sign up or log in

Post as a guest

Related