0

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

Improve this question
4
  • 1
    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 :) 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. 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. 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 Commented Dec 20, 2018 at 13:06

1 Answer 1

Reset to default
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
Improve this answer
Sign up to request clarification or add additional context in comments.

5 Comments

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).
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
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.
@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.
Nice! This makes so much more sense :)

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.