Loop through headers and copy and paste

hartsie

Board Regular
Joined
May 6, 2020
Messages
53
Office Version
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
 

Some videos you may like

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,533
Office Version
2013, 2007
Platform
Windows
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
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,533
Office Version
2013, 2007
Platform
Windows
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
 

hartsie

Board Regular
Joined
May 6, 2020
Messages
53
Office Version
2016
Thank you! I’ll give them a shot when I get home tonight.

Yes, both headers are in row one.

Thank you!
 

hartsie

Board Regular
Joined
May 6, 2020
Messages
53
Office Version
2016
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
 

Larry Haydn

Board Regular
Joined
Jul 18, 2019
Messages
65
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
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,533
Office Version
2013, 2007
Platform
Windows
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
 

hartsie

Board Regular
Joined
May 6, 2020
Messages
53
Office Version
2016
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
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,100,030
Messages
5,472,094
Members
406,801
Latest member
Kiran2229Kiran

This Week's Hot Topics

Top