Copy columns from sheet 1 to sheet 2 using column heading as criteria using VBA

Hi Jayant,

In Below code you can add the column names accordingly & make it in use... this will work Header wise
This code is only for 5 columns till Debit...

Something like this can be shorten & used

Option Compare Text ' this line code remove the diffrence between Date and date
Sub heading()
Dim Lastrow As Long

With Worksheets("Output")
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
End With

Sheets("Output").Activate   'to clear sheet2 "A" column
Range("A3:A" & Lastrow).ClearContents


Sheets("Dump").Activate
Cells(1, Columns.Count).End(xlToLeft).Select
Range(ActiveCell, Range("A2")).Select


For Each cell In Selection
If cell.Value = "DOCUMENT_SOURCE" Then
cell.EntireColumn.Copy
Sheets("Output").Activate
Range("A1").Select
ActiveSheet.Paste
End If
Next cell

Application.CutCopyMode = False
End Sub


Sub heading1()
Dim Lastrow As Long

With Worksheets("Output")
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
End With

Sheets("Output").Activate   'to clear sheet2 "A" column
Range("B3:B" & Lastrow).ClearContents


Sheets("Dump").Activate
Cells(1, Columns.Count).End(xlToLeft).Select
Range(ActiveCell, Range("F2")).Select


For Each cell In Selection
If cell.Value = "SOURCE_DOCUMENT_DATE" Then
cell.EntireColumn.Copy
Sheets("Output").Activate
Range("B1").Select
ActiveSheet.Paste
End If
Next cell

Application.CutCopyMode = False
End Sub

Sub heading2()
Dim Lastrow As Long

With Worksheets("Output")
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
End With

Sheets("Output").Activate   'to clear sheet2 "A" column
Range("C3:C" & Lastrow).ClearContents


Sheets("Dump").Activate
Cells(1, Columns.Count).End(xlToLeft).Select
Range(ActiveCell, Range("D2")).Select


For Each cell In Selection
If cell.Value = "SOURCE_DOCUMENT_NUMBER" Then
cell.EntireColumn.Copy
Sheets("Output").Activate
Range("C1").Select
ActiveSheet.Paste
End If
Next cell

Application.CutCopyMode = False
End Sub

Sub heading3()
Dim Lastrow As Long

With Worksheets("Output")
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
End With

Sheets("Output").Activate   'to clear sheet2 "A" column
Range("D3:D" & Lastrow).ClearContents


Sheets("Dump").Activate
Cells(1, Columns.Count).End(xlToLeft).Select
Range(ActiveCell, Range("M2")).Select


For Each cell In Selection
If cell.Value = "EVENT_TYPE" Then
cell.EntireColumn.Copy
Sheets("Output").Activate
Range("D1").Select
ActiveSheet.Paste
End If
Next cell

Application.CutCopyMode = False
End Sub


Sub heading4()
Dim Lastrow As Long

With Worksheets("Output")
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
End With

Sheets("Output").Activate   'to clear sheet2 "A" column
Range("E3:E" & Lastrow).ClearContents


Sheets("Dump").Activate
Cells(1, Columns.Count).End(xlToLeft).Select
Range(ActiveCell, Range("AI2")).Select


For Each cell In Selection
If cell.Value = "Debit" Then
cell.EntireColumn.Copy
Sheets("Output").Activate
Range("E1").Select
ActiveSheet.Paste
End If
Next cell

Application.CutCopyMode = False
End Sub



Sub heading4()
Dim Lastrow As Long

With Worksheets("Output")
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
End With

Sheets("Output").Activate   'to clear sheet2 "A" column
Range("E3:E" & Lastrow).ClearContents


Sheets("Dump").Activate
Cells(1, Columns.Count).End(xlToLeft).Select
Range(ActiveCell, Range("AI2")).Select


For Each cell In Selection
If cell.Value = "Debit" Then
cell.EntireColumn.Copy
Sheets("Output").Activate
Range("E1").Select
ActiveSheet.Paste
End If
Next cell

Application.CutCopyMode = False
End Sub