Loop through headers and copy and paste

H

hartsie

Board Regular
Joined
May 6, 2020
Messages
84
Office Version
  1. 2016
So, I am new to VBA. I have been trying to figure out looping and how to loop through my column headers to copy data from one sheet to the next. This seems like a very simple task, but its been killing me. I have shared my attempts below as a proof of my foolish efforts -- please ignore for your sanity's sake.

I simply want to copy from one sheet to another by searching the headers of Destination sheet and pasting the data with the same headers from the Source Sheet. So, it would look something like:

Destination Sheet
----------------------------
Header A = Account Number
Header B = Date
Header C = Name
Header D = Amount

Source Sheet
----------------------------
Header A = Transaction Date
Header B = Posting Date
Header C = Name
Header D = Account Number
Header E = Amount

Since the headers might not always exist in the same column, I want to be able to define a range of headers found on the destination sheet and loop through the headers on the source sheet to find the variable number of values below the headers and copy and paste to the destination sheet.

----------------------------
My failed attempts at trying this:
------------------------------------------------

Sub foreachlearn()

Dim myrange As Range
Dim mycell As Range
Dim srcrange As Range
Dim srccell As Range

Sheets("Master Sheet").Select
Range(Range("A1"), Range("A1").End(xlToRight)).Select
Set myrange = Selection

For Each mycell In myrange

If mycell.Text = "Account Number" Then
Selection.Copy

End If

Next mycell



End Sub
-------------------------------------------------------------------
Sub name_find_hdr()
'I am going to copy and paste the values from the consolidation sheet _
to the master sheet


Dim mstrWs As Worksheet 'This is the destination sheet
Dim srcWs As Worksheet 'This is the source sheet
Dim consolHdr As Range 'This is the header for the source sheet
Dim mstrHdr As Range 'This is the header for the destination sheet
Dim lkupHdr As Range 'This is the header for the property values in the destination sheet
Dim functHdr As Range 'This is the header with the functions in the destination sheet
Dim rng As Range
Dim strg As String
Dim consend1 As Range
Dim mycell As Range
Dim myrange As Range

'Set the worksheet names
Set mstrWs = Sheets("Master Sheet")
Set srcWs = Sheets("Account Consolidation")

'Create the header ranges for the source sheet
srcWs.Activate
Range("A1").End(xlToRight).Select
Set consend1 = Selection
Set consolHdr = Range("A1", consend1)

'Create the header ranges for the destination sheet
mstrWs.Activate
Set mstrHdr = mstrWs.Range("A1:L1")
Set lkupHdr = mstrWs.Range("M1:U1")
Set functHdr = mstrWs.Range("V1", Range("V1").End(xlToRight))

'mstrHdr.Find("account number").Select

srcWs.Select
consolHdr.Find(mstrWs.Range("b1").Text).Select







End Sub
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Sort by date Sort by votes
Assumes that the headers in both sheets are in row 1.
Change references where required.
Does all the headers in "Destination Sheet"
Code: 
Sub Maybe_So()
Dim sh1 As Worksheet, sh2 As Worksheet, lc2 As Long, i As Long
Set sh1 = Worksheets("Source Sheet")
Set sh2 = Worksheets("Destination Sheet")
lc2 = sh2.Cells(1, sh2.Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
    For i = 1 To lc2
        sh1.Cells(2, sh1.Rows(1).Find(sh2.Cells(1, i), , , 1).Column).Resize(sh1.UsedRange.Rows.Count - 1).Copy sh2.Cells(2, i)
    Next i
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Select the headers in row 1 to add to that column.
Macro needs to be run from the sheet where you select your headers (Destination Sheet)
Change references as required.
Code: 
Sub Maybe_So_2()
Dim sh1 As Worksheet, sh2 As Worksheet, lc2 As Long, c As Range
Set sh1 = Worksheets("Source Sheet")
Set sh2 = Worksheets("Destination Sheet")
lc2 = sh2.Cells(1, sh2.Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
With sh2
    For Each c In Selection
        c.Offset(1).Resize(sh1.UsedRange.Rows.Count - 1).Value = sh1.Cells(2, sh1.Rows(1).Find(c.Value, , , 1).Column).Resize(sh1.UsedRange.Rows.Count - 1).Value
'        Above line would be mostly for values only
'        Following works also as it copies and pastes
'        sh1.Cells(2, sh1.Rows(1).Find(c.Value, , , 1).Column).Resize(sh1.UsedRange.Rows.Count - 1).Copy .Cells(2, c.Column)
    Next c
End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thank you! I’ll give them a shot when I get home tonight.

Yes, both headers are in row one.

Thank you!
 
Upvote 0
So - I love the MACRO. However, for some reason, the second one you provided is not going through each of the headers unless I select each header and run. Do you think I need to change something else?

Sub Maybe_So_2()
Dim sh1 As Worksheet, sh2 As Worksheet, lc2 As Long, c As Range
Set sh1 = Worksheets("Account Consolidation")
Set sh2 = Worksheets("Master Sheet")
lc2 = sh2.Cells(1, sh2.Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
With sh2

On Error Resume Next

For Each c In Selection
c.Offset(1).Resize(sh1.UsedRange.Rows.Count - 1).Value = sh1.Cells(2, sh1.Rows(1).Find(c.Value, , , 1).Column).Resize(sh1.UsedRange.Rows.Count - 1).Value
' Above line would be mostly for values only
' Following works also as it copies and pastes
'sh1.Cells(2, sh1.Rows(1).Find(c.Value, , , 1).Column).Resize(sh1.UsedRange.Rows.Count - 1).Copy .Cells(2, c.Column)
Next c
End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0
VBA Code: 
Option Explicit
Option Compare Text

Sub CopyColumns()
'==============================================================
'   Copies column data from source to destination
'   by reading the headings.
'   Assume that both worksheets are within the same workbook.
'   Hope this is very easy to understand.
'==============================================================
Dim WB As Workbook
Dim Src As Worksheet
Dim Dest As Worksheet
Dim LastSrcRow As Long
Dim NewDestRow As Long

    '=============================================================
    '   First, let us identify this workbook and its worksheets
    '=============================================================
    Set WB = ActiveWorkbook                                 'Refers to this workbook
    Set Src = WB.Sheets("My source worksheet name")         'Identifies the source worksheet.      Put your worksheet name within the quotes.
    Set Dest = WB.Sheets("My destination worksheet name")   'Identifies the destination worksheet. Put your worksheet name within the quotes.

    '=====================================================================
    '   I am assuming that your destination worksheet has existing data
    '   so we need to find a new row to paste the data.
    '
    '   We also need to know the last data row of the source, so we
    '   won't copy lots of blank cells across.
    '=====================================================================
    LastSrcRow = Src.Range("A1048576").End(xlUp).Row        'Last data row in source
    LastDestRow = Dest.Range("A1048576").End(xlUp).Row + 1  'New row below the last data row in destination.
    
    '===================================================
    '   You have 5 columns in the source,
    '   so let us look at each of the column headings
    '   First, look at the source, column A
    '===================================================
    Select Case Src.Range("A1")
    
        '==============================
        '   If A1 = Transaction Date
        '==============================
        Case "Transaction Date"
            '========================================================
            '   Copy this column's data to column B in destination
            '========================================================
            Src.Range("A2:A" & LastSrcRow).Copy Dest.Range("B" & NewDestRow)
            
        Case "Name"
            Src.Range("A2:A" & LastSrcRow).Copy Dest.Range("C" & NewDestRow)
            
        Case "Account Number"
            Src.Range("A2:A" & LastSrcRow).Copy Dest.Range("A" & NewDestRow)
            
        Case "Amount"
            Src.Range("A2:A" & LastSrcRow).Copy Dest.Range("D" & NewDestRow)
    
    End Select

    '==================================
    '   Look at the source, column B
    '==================================
    Select Case Src.Range("B1")
    
        '==============================
        '   If B1 = Transaction Date
        '==============================
        Case "Transaction Date"
            '========================================================
            '   Copy this column's data to column B in destination
            '========================================================
            Src.Range("B2:B" & LastSrcRow).Copy Dest.Range("B" & NewDestRow)
            
        Case "Name"
            Src.Range("B2:B" & LastSrcRow).Copy Dest.Range("C" & NewDestRow)
            
        Case "Account Number"
            Src.Range("B2:B" & LastSrcRow).Copy Dest.Range("A" & NewDestRow)
            
        Case "Amount"
            Src.Range("B2:B" & LastSrcRow).Copy Dest.Range("D" & NewDestRow)
    
    End Select

    '==================================
    '   Look at the source, column C
    '==================================
    Select Case Src.Range("C1")
    
        '==============================
        '   If C1 = Transaction Date
        '==============================
        Case "Transaction Date"
            '========================================================
            '   Copy this column's data to column B in destination
            '========================================================
            Src.Range("C2:C" & LastSrcRow).Copy Dest.Range("B" & NewDestRow)
            
        Case "Name"
            Src.Range("C2:C" & LastSrcRow).Copy Dest.Range("C" & NewDestRow)
            
        Case "Account Number"
            Src.Range("C2:C" & LastSrcRow).Copy Dest.Range("A" & NewDestRow)
            
        Case "Amount"
            Src.Range("C2:C" & LastSrcRow).Copy Dest.Range("D" & NewDestRow)
    
    End Select

    '==================================
    '   Look at the source, column D
    '==================================
    Select Case Src.Range("D1")
    
        '==============================
        '   If D1 = Transaction Date
        '==============================
        Case "Transaction Date"
            '========================================================
            '   Copy this column's data to column B in destination
            '========================================================
            Src.Range("D2:D" & LastSrcRow).Copy Dest.Range("B" & NewDestRow)
            
        Case "Name"
            Src.Range("D2:D" & LastSrcRow).Copy Dest.Range("C" & NewDestRow)
            
        Case "Account Number"
            Src.Range("D2:D" & LastSrcRow).Copy Dest.Range("A" & NewDestRow)
            
        Case "Amount"
            Src.Range("D2:D" & LastSrcRow).Copy Dest.Range("D" & NewDestRow)
    
    End Select

    '==================================
    '   Look at the source, column E
    '==================================
    Select Case Src.Range("E1")
    
        '==============================
        '   If E1 = Transaction Date
        '==============================
        Case "Transaction Date"
            '========================================================
            '   Copy this column's data to column B in destination
            '========================================================
            Src.Range("E2:E" & LastSrcRow).Copy Dest.Range("B" & NewDestRow)
            
        Case "Name"
            Src.Range("E2:E" & LastSrcRow).Copy Dest.Range("C" & NewDestRow)
            
        Case "Account Number"
            Src.Range("E2:E" & LastSrcRow).Copy Dest.Range("A" & NewDestRow)
            
        Case "Amount"
            Src.Range("E2:E" & LastSrcRow).Copy Dest.Range("D" & NewDestRow)
    
    End Select

    '=======================
    '   Save the workbook
    '=======================
    WB.Save
    
End Sub
 
Upvote 0
Good to hear that you've got it under control.
Yes, with the macro in Post #3, you select any header or headers, consecutive or not and run the macro.
Good luck
 
Upvote 0
Larry Haydn said:
VBA Code: 
Option Explicit
Option Compare Text

Sub CopyColumns()
'==============================================================
'   Copies column data from source to destination
'   by reading the headings.
'   Assume that both worksheets are within the same workbook.
'   Hope this is very easy to understand.
'==============================================================
Dim WB As Workbook
Dim Src As Worksheet
Dim Dest As Worksheet
Dim LastSrcRow As Long
Dim NewDestRow As Long

    '=============================================================
    '   First, let us identify this workbook and its worksheets
    '=============================================================
    Set WB = ActiveWorkbook                                 'Refers to this workbook
    Set Src = WB.Sheets("My source worksheet name")         'Identifies the source worksheet.      Put your worksheet name within the quotes.
    Set Dest = WB.Sheets("My destination worksheet name")   'Identifies the destination worksheet. Put your worksheet name within the quotes.

    '=====================================================================
    '   I am assuming that your destination worksheet has existing data
    '   so we need to find a new row to paste the data.
    '
    '   We also need to know the last data row of the source, so we
    '   won't copy lots of blank cells across.
    '=====================================================================
    LastSrcRow = Src.Range("A1048576").End(xlUp).Row        'Last data row in source
    LastDestRow = Dest.Range("A1048576").End(xlUp).Row + 1  'New row below the last data row in destination.
    
    '===================================================
    '   You have 5 columns in the source,
    '   so let us look at each of the column headings
    '   First, look at the source, column A
    '===================================================
    Select Case Src.Range("A1")
    
        '==============================
        '   If A1 = Transaction Date
        '==============================
        Case "Transaction Date"
            '========================================================
            '   Copy this column's data to column B in destination
            '========================================================
            Src.Range("A2:A" & LastSrcRow).Copy Dest.Range("B" & NewDestRow)
            
        Case "Name"
            Src.Range("A2:A" & LastSrcRow).Copy Dest.Range("C" & NewDestRow)
            
        Case "Account Number"
            Src.Range("A2:A" & LastSrcRow).Copy Dest.Range("A" & NewDestRow)
            
        Case "Amount"
            Src.Range("A2:A" & LastSrcRow).Copy Dest.Range("D" & NewDestRow)
    
    End Select

    '==================================
    '   Look at the source, column B
    '==================================
    Select Case Src.Range("B1")
    
        '==============================
        '   If B1 = Transaction Date
        '==============================
        Case "Transaction Date"
            '========================================================
            '   Copy this column's data to column B in destination
            '========================================================
            Src.Range("B2:B" & LastSrcRow).Copy Dest.Range("B" & NewDestRow)
            
        Case "Name"
            Src.Range("B2:B" & LastSrcRow).Copy Dest.Range("C" & NewDestRow)
            
        Case "Account Number"
            Src.Range("B2:B" & LastSrcRow).Copy Dest.Range("A" & NewDestRow)
            
        Case "Amount"
            Src.Range("B2:B" & LastSrcRow).Copy Dest.Range("D" & NewDestRow)
    
    End Select

    '==================================
    '   Look at the source, column C
    '==================================
    Select Case Src.Range("C1")
    
        '==============================
        '   If C1 = Transaction Date
        '==============================
        Case "Transaction Date"
            '========================================================
            '   Copy this column's data to column B in destination
            '========================================================
            Src.Range("C2:C" & LastSrcRow).Copy Dest.Range("B" & NewDestRow)
            
        Case "Name"
            Src.Range("C2:C" & LastSrcRow).Copy Dest.Range("C" & NewDestRow)
            
        Case "Account Number"
            Src.Range("C2:C" & LastSrcRow).Copy Dest.Range("A" & NewDestRow)
            
        Case "Amount"
            Src.Range("C2:C" & LastSrcRow).Copy Dest.Range("D" & NewDestRow)
    
    End Select

    '==================================
    '   Look at the source, column D
    '==================================
    Select Case Src.Range("D1")
    
        '==============================
        '   If D1 = Transaction Date
        '==============================
        Case "Transaction Date"
            '========================================================
            '   Copy this column's data to column B in destination
            '========================================================
            Src.Range("D2:D" & LastSrcRow).Copy Dest.Range("B" & NewDestRow)
            
        Case "Name"
            Src.Range("D2:D" & LastSrcRow).Copy Dest.Range("C" & NewDestRow)
            
        Case "Account Number"
            Src.Range("D2:D" & LastSrcRow).Copy Dest.Range("A" & NewDestRow)
            
        Case "Amount"
            Src.Range("D2:D" & LastSrcRow).Copy Dest.Range("D" & NewDestRow)
    
    End Select

    '==================================
    '   Look at the source, column E
    '==================================
    Select Case Src.Range("E1")
    
        '==============================
        '   If E1 = Transaction Date
        '==============================
        Case "Transaction Date"
            '========================================================
            '   Copy this column's data to column B in destination
            '========================================================
            Src.Range("E2:E" & LastSrcRow).Copy Dest.Range("B" & NewDestRow)
            
        Case "Name"
            Src.Range("E2:E" & LastSrcRow).Copy Dest.Range("C" & NewDestRow)
            
        Case "Account Number"
            Src.Range("E2:E" & LastSrcRow).Copy Dest.Range("A" & NewDestRow)
            
        Case "Amount"
            Src.Range("E2:E" & LastSrcRow).Copy Dest.Range("D" & NewDestRow)
    
    End Select

    '=======================
    '   Save the workbook
    '=======================
    WB.Save
    
End Sub
Click to expand...

That is a beautifully written script! I can’t wait to dive into it this weekend.

Thank you so much for your time and your help! I will try to learn and pay it forward as best as I am able.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
VBA code to cut and paste multiple filtered rows based on multiple criteria
Replies
2
Views
445
Alex Blakenburg
A
C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
196
Coco1
C
R
  • Solved
Move and Rearrange Data based on Header
2
Replies
19
Views
940
ruinedelf
R
F
  • Question
VBA Import columns by headers - Need prompts to select workbook/sheet name
Replies
2
Views
176
floggingmolly
F
H
  • Solved
Consolidate data from selected sheets into master sheet & automatically update data.
Replies
8
Views
663
Joe4
Joe4

Forum statistics

Threads
1,214,588
Messages
6,120,409
Members
448,959
Latest member
camelliaCase

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