CODEWITHSUNDEEP
vbaexcel
rebecca_m_wonk
rebecca_m_wonk

Reputation: 21

Pull Columns with same name and copy into different worksheet

I am trying to copy multiple columns with the same header name into a new worksheet.

The problem I am having is it only copies one column and leaves the other blank.

In this example I want the date to be in column 1 and in column 5 but it only places the column in Target Column 5.

Sub MoveColumns()
' MoveColumns Macro

' Description: Rearrange columns in Excel based on column header
Dim iRow As Long
Dim iCol As Long
'Constant values
data_sheet1 = InputBox("Specify the name of the Sheet that needs to be reorganized:") 'Create Input Box to ask the user which sheet needs to be reorganised
target_sheet = "Final Report" 'Specify the sheet to store the results
iRow = Sheets(data_sheet1).UsedRange.Rows.Count 'Determine how many rows are in use
'Create a new sheet to store the results
Worksheets.Add.Name = "Final Report"
'Start organizing columns
For iCol = 1 To Sheets(data_sheet1).UsedRange.Columns.Count
'Sets the TargetCol to zero in order to prevent overwriting existing targetcolumns
TargetCol = 0
'Read the header of the original sheet to determine the column order

If Sheets(data_sheet1).Cells(1, iCol).value = "DATE" Then TargetCol = 1
If Sheets(data_sheet1).Cells(1, iCol).value = "SYSTEM NAME" Then TargetCol = 2
If Sheets(data_sheet1).Cells(1, iCol).value = "CH" Then TargetCol = 3
If Sheets(data_sheet1).Cells(1, iCol).value = "CARR KEY" Then TargetCol = 3
If Sheets(data_sheet1).Cells(1, iCol).value = "FLAG" Then TargetCol = 4
If Sheets(data_sheet1).Cells(1, iCol).value = "DATE" Then TargetCol = 5



'If a TargetColumn was determined (based upon the header information) then copy the column to the right spot
If TargetCol <> 0 Then
'Select the column and copy it
Sheets(data_sheet1).Range(Sheets(data_sheet1).Cells(1, iCol), Sheets(data_sheet1).Cells(iRow, iCol)).Copy Destination:=Sheets(target_sheet).Cells(1, TargetCol)
End If
Next iCol 'Move to the next column until all columns are read


End Sub

Upvotes: 2

Views: 763

Answers (1)

Subodh Tiwari sktneer
Subodh Tiwari sktneer

Reputation: 9976

Change your second date column header to something else like Date2 which I have used in the code below. Otherwise your first condition will always be evaluated as True and it will pick the first column always.

You may try it like thie...

Sub MoveColumns()
' MoveColumns Macro

' Description: Rearrange columns in Excel based on column header
Dim iRow As Long
Dim iCol As Long
Dim TargetCol As Long
Dim FirstDate As Boolean
'Constant values
data_sheet1 = InputBox("Specify the name of the Sheet that needs to be reorganized:") 'Create Input Box to ask the user which sheet needs to be reorganised
target_sheet = "Final Report" 'Specify the sheet to store the results
iRow = Sheets(data_sheet1).UsedRange.Rows.Count 'Determine how many rows are in use
'Create a new sheet to store the results
Worksheets.Add.Name = "Final Report"
'Start organizing columns
For iCol = 1 To Sheets(data_sheet1).UsedRange.Columns.Count
'Sets the TargetCol to zero in order to prevent overwriting existing targetcolumns
TargetCol = 0
'Read the header of the original sheet to determine the column order

If LCase(Sheets(data_sheet1).Cells(1, iCol).Value) = "date" Then
    If Not FirstDate Then
        TargetCol = 1
        FirstDate = True
    Else
        TargetCol = 6
    End If
ElseIf LCase(Sheets(data_sheet1).Cells(1, iCol).Value) = "system name" Then
    TargetCol = 2
ElseIf LCase(Sheets(data_sheet1).Cells(1, iCol).Value) = "ch" Then
    TargetCol = 3
ElseIf LCase(Sheets(data_sheet1).Cells(1, iCol).Value) = "carr key" Then
    TargetCol = 4
ElseIf LCase(Sheets(data_sheet1).Cells(1, iCol).Value) = "flag" Then
    TargetCol = 5
ElseIf LCase(Sheets(data_sheet1).Cells(1, iCol).Value) = "date" Then
    TargetCol = 6
End If



'If a TargetColumn was determined (based upon the header information) then copy the column to the right spot
If TargetCol <> 0 Then
'Select the column and copy it
Sheets(data_sheet1).Range(Sheets(data_sheet1).Cells(1, iCol), Sheets(data_sheet1).Cells(iRow, iCol)).Copy Destination:=Sheets(target_sheet).Cells(1, TargetCol)
End If
Next iCol 'Move to the next column until all columns are read
End Sub

Upvotes: 1

Related Questions