VBA REQUEST: Paste Values of Multiple Sheets Based on the *Header Name* in Destination Sheet

R

ramkrau

New Member
Joined
Jan 9, 2019
Messages
14
I've tried to google high and low for this, but I haven't gotten ANYWHERE. Please, someone help!!!

I've got a workbook with 5 worksheets. Every workbook has Row 1 as column headers. Some of the column headers are common to all worksheets, but some worksheets have their own unique headers. They are NOT consistently in the same order.
Ex: They all share a column with the header "Name", "Date", and "Address". Some sheets have additional columns like "Price" or "Unit". Some sheets have "Price" as Column A, whereas some have "Name" as Column A. There is no pattern that can be used for the VBA.

I have a destination worksheet with headers "Name" "Date" and "Address". I want a VBA that will cycle through all of the tabs, and ONLY paste the information from "Name" "Date" and "Address" and ignore other columns (like "Price" or "Unit"), pasting the information from Sheet 1, then when that's all done, move to Sheet 2 and start pasting that information right below what was pasted from Sheet 1.

The macro will need to utilize the column header text so that it knows what info to copy and paste because the columns are not in the same order on the various other sheets. I just don't know how to do that with formulas or where to begin with a macro. Please, someone help!!!!!
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Sort by date Sort by votes
Give this a crack:

*It does assume the destination sheet has the headers "Name", "Date", and "Address" in columns A:C respectively.

VBA Code: 
Sub MoveToDestination()

Dim ws As Worksheet
Dim destws As Worksheet
Dim rownum As Long
Dim destrownum As Long
Dim colnum As Long
Dim lastrow As Long
Dim lastcol As Long

Set destws = Sheets("Destination") ''change this to your destination sheet name

For Each ws In Worksheets
destrownum = destws.Cells(destws.Rows.Count, "A").End(xlUp).Row + 1
    If ws.Name <> "Destination" Then ''change this to your destination sheet name
        lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        lastcol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
        rownum = 1
        colnum = 1
            Do Until colnum = lastcol + 1
                If ws.Cells(1, colnum) = "Name" And lastrow > 1 Then
                ws.Range(ws.Cells(2, colnum), ws.Cells(lastrow, colnum)).Copy destws.Cells(destrownum, 1)
                ElseIf ws.Cells(1, colnum) = "Date" And lastrow > 1 Then
                ws.Range(ws.Cells(2, colnum), ws.Cells(lastrow, colnum)).Copy destws.Cells(destrownum, 2)
                ElseIf ws.Cells(1, colnum) = "Address" And lastrow > 1 Then
                ws.Range(ws.Cells(2, colnum), ws.Cells(lastrow, colnum)).Copy destws.Cells(destrownum, 3)
                End If
            colnum = colnum + 1
            Loop
    End If
Next ws

End Sub
 
Upvote 0
Another approach:
VBA Code: 
Public Sub Copy_Columns_To_Destination_Sheet()

    Dim destinationSheet As Worksheet, destRow As Long, destCol As Variant
    Dim ws As Worksheet, wsRow As Long, wsCol As Variant
    Dim columnHeader As Variant
    
    Set destinationSheet = ThisWorkbook.Worksheets("data")   'CHANGE THIS - NAME OF DESTINATION SHEET
    
    For Each ws In ThisWorkbook.Worksheets
        If Not ws Is destinationSheet Then
            For Each columnHeader In Array("Name", "Date", "Address")
                With ws
                    wsCol = Application.Match(columnHeader, .Rows(1), 0)
                    If Not IsError(wsCol) Then
                        wsRow = .Cells(.Rows.Count, wsCol).End(xlUp).Row
                        destCol = Application.Match(columnHeader, destinationSheet.Rows(1), 0)
                        destRow = destinationSheet.Cells(destinationSheet.Rows.Count, destCol).End(xlUp).Row + 1
                        .Range(.Cells(2, wsCol), .Cells(wsRow, wsCol)).Copy destinationSheet.Cells(destRow, destCol)
                    Else
                        MsgBox "Column heading " & columnHeader & " not found in row 1 of " & .Name
                    End If
                End With
            Next
        End If
    Next
        
End Sub
 
Upvote 0
John_w said:
Another approach:
VBA Code: 
Public Sub Copy_Columns_To_Destination_Sheet()

    Dim destinationSheet As Worksheet, destRow As Long, destCol As Variant
    Dim ws As Worksheet, wsRow As Long, wsCol As Variant
    Dim columnHeader As Variant
   
    Set destinationSheet = ThisWorkbook.Worksheets("data")   'CHANGE THIS - NAME OF DESTINATION SHEET
   
    For Each ws In ThisWorkbook.Worksheets
        If Not ws Is destinationSheet Then
            For Each columnHeader In Array("Name", "Date", "Address")
                With ws
                    wsCol = Application.Match(columnHeader, .Rows(1), 0)
                    If Not IsError(wsCol) Then
                        wsRow = .Cells(.Rows.Count, wsCol).End(xlUp).Row
                        destCol = Application.Match(columnHeader, destinationSheet.Rows(1), 0)
                        destRow = destinationSheet.Cells(destinationSheet.Rows.Count, destCol).End(xlUp).Row + 1
                        .Range(.Cells(2, wsCol), .Cells(wsRow, wsCol)).Copy destinationSheet.Cells(destRow, destCol)
                    Else
                        MsgBox "Column heading " & columnHeader & " not found in row 1 of " & .Name
                    End If
                End With
            Next
        End If
    Next
       
End Sub
Click to expand...
Hi John! I have a similar problem and your code works great! However, I am running into a few problems and was wondering if you can help:
  • The headers in my source worksheets start in row 2 and the headers in my destination sheet start in row 3 - how can I modify that?
  • I have columns with blank cells and I would like the code to copy and paste the entire column (including the blanks). The code is doing that right now for one sheet at a time. However, when it goes to the next sheet, it ignores the last blank cells in the previous sheet and fills it with values from the next sheet. How do I mitigate this?
    • Example: source sheets = HK, Australia
Thank you SO MUCH!
 
Upvote 0
fredisred said:
Hi John! I have a similar problem and your code works great! However, I am running into a few problems and was wondering if you can help:
  • The headers in my source worksheets start in row 2 and the headers in my destination sheet start in row 3 - how can I modify that?
  • I have columns with blank cells and I would like the code to copy and paste the entire column (including the blanks). The code is doing that right now for one sheet at a time. However, when it goes to the next sheet, it ignores the last blank cells in the previous sheet and fills it with values from the next sheet. How do I mitigate this?
    • Example: source sheets = HK, Australia
Thank you SO MUCH!
Click to expand...
Accidentally posted without finishing:

Example:
Source sheets = HK, Australia
Columns = Job code (unique values with no blank rows/cells), base salary (some rows/cells are empty)
Issue: towards the end of the "HK" sheet, the last base salary information is $60,000 for job code "123", and while the job code column continues on (i.e. "234, "345"), those job codes have no base salary information. Instead of continuing to copy those blank cells, the code then proceeds to pull from the "Australia" sheet and then fills base salary information for job codes "234", "345", etc., even though those job codes do not have base salary information.
 
Upvote 0
fredisred said:
The headers in my source worksheets start in row 2 and the headers in my destination sheet start in row 3 - how can I modify that?
Click to expand...
This searches row 1 in the source sheet. Change the 1 to 2 for row 2.
VBA Code: 
wsCol = Application.Match(columnHeader, .Rows(1), 0)

and the 2 here means row 2 (the first data row). Change the 2 to 3 for row 3 as the first data row.
VBA Code: 
.Range(.Cells(2, wsCol), .Cells(wsRow, wsCol)).Copy destinationSheet.Cells(destRow, destCol)

This searches row 1 in the destination sheet. Change the 1 to 3 for row 3.
VBA Code: 
destCol = Application.Match(columnHeader, destinationSheet.Rows(1), 0)

fredisred said:
I have columns with blank cells and I would like the code to copy and paste the entire column (including the blanks). The code is doing that right now for one sheet at a time. However, when it goes to the next sheet, it ignores the last blank cells in the previous sheet and fills it with values from the next sheet. How do I mitigate this?
Click to expand...

This finds the last populated cell in the destination column and adds 1 to the row number to calculate the new destination row.
VBA Code: 
destRow = destinationSheet.Cells(destinationSheet.Rows.Count, destCol).End(xlUp).Row + 1

However, if that column has blank cell(s) at the bottom the row number will be wrong. You could change it to find the last populated cell in the same fixed column that you know never contains blanks at the bottom, e.g column A (the 1):
VBA Code: 
destRow = destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Row + 1
If there is not such a column you could add another For Each columnHeader loop before the current one which calculates the maximum last row number for all the columns and use that maximum last row number as the destRow in the Copy line.
 
Upvote 0
John_w said:
This searches row 1 in the source sheet. Change the 1 to 2 for row 2.
VBA Code: 
wsCol = Application.Match(columnHeader, .Rows(1), 0)

and the 2 here means row 2 (the first data row). Change the 2 to 3 for row 3 as the first data row.
VBA Code: 
.Range(.Cells(2, wsCol), .Cells(wsRow, wsCol)).Copy destinationSheet.Cells(destRow, destCol)

This searches row 1 in the destination sheet. Change the 1 to 3 for row 3.
VBA Code: 
destCol = Application.Match(columnHeader, destinationSheet.Rows(1), 0)



This finds the last populated cell in the destination column and adds 1 to the row number to calculate the new destination row.
VBA Code: 
destRow = destinationSheet.Cells(destinationSheet.Rows.Count, destCol).End(xlUp).Row + 1

However, if that column has blank cell(s) at the bottom the row number will be wrong. You could change it to find the last populated cell in the same fixed column that you know never contains blanks at the bottom, e.g column A (the 1):
VBA Code: 
destRow = destinationSheet.Cells(destinationSheet.Rows.Count, 1).End(xlUp).Row + 1
If there is not such a column you could add another For Each columnHeader loop before the current one which calculates the maximum last row number for all the columns and use that maximum last row number as the destRow in the Copy line.
Click to expand...
Hi John,

Thank you so much!! I was able to fix the column header issue! However, when I changed it to find the last populated cell in the same fixed column (source sheet column E -"Job Code", which is 5), the code somehow skips a lot of rows in the second sheet and did not copy and paste them into the destination sheet. Any idea why this might be happening? Apologies for so many questions - I'm super new to this and trying to learn! I've included the full code below for reference. Thank you so much for your help!

VBA Code: 
Public Sub Copy_Columns_To_Destination_Sheet()

    Dim destinationSheet As Worksheet, destRow As Long, destCol As Variant
    Dim ws As Worksheet, wsRow As Long, wsCol As Variant
    Dim columnHeader As Variant
    
    Set destinationSheet = ThisWorkbook.Worksheets("ws2")   'CHANGE THIS - NAME OF DESTINATION SHEET
    
    For Each ws In ThisWorkbook.Worksheets
        If Not ws Is destinationSheet Then
            For Each columnHeader In Array("Currency", "Job Code", "Base Salary Perc25_IW")
                With ws
                    wsCol = Application.Match(columnHeader, .Rows(2), 0)
                    If Not IsError(wsCol) Then
                        wsRow = .Cells(.Rows.Count, wsCol).End(xlUp).Row
                        destCol = Application.Match(columnHeader, destinationSheet.Rows(3), 0)
                        destRow = destinationSheet.Cells(destinationSheet.Rows.Count, 5).End(xlUp).Row + 1
                        .Range(.Cells(3, wsCol), .Cells(wsRow, wsCol)).Copy destinationSheet.Cells(destRow, destCol)
                    Else
                        MsgBox "Column heading " & columnHeader & " not found in row 1 of " & .Name
                    End If
                End With
            Next
        End If
    Next
        
End Sub
 
Upvote 0
You've applied my changes correctly, however I think I missed a bit of code which looks in column E of the destination sheet to determine the next row to copy the data to, after the first sheet columns have been copied.

See if this macro works for you. I've added comments to hopefully help you understand it.
VBA Code: 
Public Sub Copy_Columns_To_Destination_Sheet2()

    Dim destinationSheet As Worksheet, destRow As Long, destCol As Variant, destRowColE As Long
    Dim ws As Worksheet, wsRow As Long, wsCol As Variant
    Dim columnHeading As Variant
   
    Set destinationSheet = ThisWorkbook.Worksheets("ws2")   'CHANGE THIS - NAME OF DESTINATION SHEET
   
    destRowColE = 0
    For Each ws In ThisWorkbook.Worksheets
        If Not ws Is destinationSheet Then
            For Each columnHeading In Array("Currency", "Job Code", "Base Salary Perc25_IW")
                With ws
                    'Find this column heading in row 2 of source sheet and save its column number
                    wsCol = Application.Match(columnHeading, .Rows(2), 0)
                    If Not IsError(wsCol) Then
                        'Determine last row with data for this column in source sheet
                        wsRow = .Cells(.Rows.Count, wsCol).End(xlUp).Row
                        'Find this column heading in row 3 of destination sheet and save its column number
                        destCol = Application.Match(columnHeading, destinationSheet.Rows(3), 0)
                        'Has destination row of column E in destination sheet been calculated yet?
                        If destRowColE = 0 Then
                            'No, so determine last row with data for this column in destination sheet and use that as the destination row for copying data to
                            destRow = destinationSheet.Cells(destinationSheet.Rows.Count, destCol).End(xlUp).Row + 1
                        Else
                            'Yes, so use it as the destination row for copying data to
                            destRow = destRowColE
                        End If
                        'Copy this column from row 3 (first data row) in source sheet to column in destination sheet starting at destination row
                        .Range(.Cells(3, wsCol), .Cells(wsRow, wsCol)).Copy destinationSheet.Cells(destRow, destCol)
                    Else
                        MsgBox "Column heading " & columnHeading & " not found in row 2 of " & .Name
                    End If
                End With
            Next
            'Determine last row number with data in column E of destination sheet.  All subsequent source sheet columns will be copied to destination sheet columns starting at this row
            destRowColE = destinationSheet.Cells(destinationSheet.Rows.Count, "E").End(xlUp).Row + 1
        End If
    Next
       
End Sub
 
Last edited:
Upvote 0
Thank you SO MUCH John! Thank you for being so detailed to help me learn too! Worked wonderfully and saved me so much time!! You are the best!
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Copying columns of data to second worksheet based on input on third worksheet
Replies
2
Views
168
StuartE
S
N
  • Solved
Excel 2016 VBA - Pull data from multiple sheets to One with specificities
Replies
3
Views
301
mumps
mumps
C
  • Solved
Split into worksheets based on multiple criteria
Replies
7
Views
146
Fuji
F
A
  • Question Question
populate data based on Matching headers for multiple sheets across files
Replies
0
Views
191
Amer Omar
A
V
  • Question Question
Copy Range from Multiple Sheets and Paste Link into a Single Sheet
Replies
2
Views
182
vbascientist
V

Forum statistics

Threads
1,223,910
Messages
6,175,316
Members
452,634
Latest member
cpostell

Share this page

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