asked on

VBA: transfer data from one sheet to another

Hello experts,

I use the following script to transfer data from active sheet to another sheet (CostCodeimport sheet)

Sub move_columns_CostCode_import()


' Description: Rearrange columns in Excel based on column header
Dim iRow As Long
Dim iCol As Long
Dim c As Range
Application.DisplayAlerts = False
On Error Resume Next
Sheets("CostCode_import").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'Constant values
data_sheet1 = ActiveSheet.Name
target_sheet = "CostCode_import" '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 = "CostCode_import"
Application.DisplayAlerts = False
On Error Resume Next

Application.DisplayAlerts = False

'Delete unecessary rows

With Sheets(data_sheet1)

If Sheets(data_sheet1).Range("A1").Value = "" Then Sheets(data_sheet1).Rows("1:5").Delete .Columns("A:A").Delete

End With

Application.DisplayAlerts = True
'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 = "Access CostCode" Then TargetCol = 1
If Sheets(data_sheet1).Cells(1, iCol).Value = "Project ID" Then TargetCol = 2
If Sheets(data_sheet1).Cells(1, iCol).Value = "Cost code Id" Then TargetCol = 3
If Sheets(data_sheet1).Cells(1, iCol).Value = "Global ID" Then TargetCol = 4
If Sheets(data_sheet1).Cells(1, iCol).Value = "Cost code Id" Then TargetCol = 5
If Sheets(data_sheet1).Cells(1, iCol).Value = "Global ID" Then TargetCol = 6
If Sheets(data_sheet1).Cells(1, iCol).Value = "Cost code Name" Then TargetCol = 7
If Sheets(data_sheet1).Cells(1, iCol).Value = "Accounting System" Then TargetCol = 8

'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

'Clean up

ActiveSheet.UsedRange.ClearFormats

End Sub

Open in new window

I don't know why the code doesn't work properly when I repeat a Targetcolumn name in different columns ex :

If Sheets(data_sheet1).Cells(1, iCol).Value = "Cost code Id" Then TargetCol = 3
If Sheets(data_sheet1).Cells(1, iCol).Value = "Global ID" Then TargetCol = 4
If Sheets(data_sheet1).Cells(1, iCol).Value = "Cost code Id" Then TargetCol = 5
If Sheets(data_sheet1).Cells(1, iCol).Value = "Global ID" Then TargetCol = 6

I have column 3 and 4 empty and column 5 and 6 with the right data and I should have colum 3, column 4 with the same data with column 5 and 6 respectively.

Thank you again for your help.

Roy Cox

There's a few issues.

1. Don't put error handlers in until the code is working, if you do you will not receive error messages that may be helpful.
2. Look at Option Explicit and declaring variables.
3. You with End With Statement is unnecessary and not used correctly.
4. Don't use UsedRange, it may return an incorrect range.

Attach an example workbook so that I can understand your code more easily.

Roy Cox

I've tidied up the code but I'm not sure what you are checking for with the Loop, as I said if you attach an example workbook I can probably figure it out.

Sub move_columns_CostCode_import()


' Description: Rearrange columns in Excel based on column header
    Dim iRow As Long
    Dim iCol As Long
    Dim c As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("CostCode_import").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    'Constant values
    data_sheet1 = ActiveSheet.Name
    target_sheet = "CostCode_import"    'Specify the sheet to store the results

    'Create a new sheet to store the results
    Worksheets.Add.Name = "CostCode_import"
    Application.DisplayAlerts = False
    'On Error Resume Next

    Application.DisplayAlerts = False

    'Delete unecessary rows

    With Sheets(data_sheet1)

        If .Range("A1").Value = "" Then .Rows("1:5").Delete .Columns("A:A").Delete

        iRow = .Range("A1").Rows.Count    'Determine how many rows are in use

        Application.DisplayAlerts = True
        'Start organizing columns
        For iCol = 1 To .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 .Cells(1, iCol).Value = "Access CostCode" Then TargetCol = 1
            If .Cells(1, iCol).Value = "Project ID" Then TargetCol = 2
            If .Cells(1, iCol).Value = "Cost code Id" Then TargetCol = 3
            If .Cells(1, iCol).Value = "Global ID" Then TargetCol = 4
            If .Cells(1, iCol).Value = "Cost code Id" Then TargetCol = 5
            If .Cells(1, iCol).Value = "Global ID" Then TargetCol = 6
            If .Cells(1, iCol).Value = "Cost code Name" Then TargetCol = 7
            If .Cells(1, iCol).Value = "Accounting System" Then TargetCol = 8

            '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
                .Range(.Cells(1, iCol), .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

        'Clean up

        ActiveSheet.UsedRange.ClearFormats

    End Sub

Open in new window

Luis Diaz

ASKER

Please find attached the reference file.
Move-columns.xlsm

Subodh Tiwari (Neeraj)

If empty columns is your issue, try this.....

Remember I have not changed any other lines of code, just added a variable col and used in the destination reference in the copy and paste line of code.

Sub move_columns_CostCode_import()

' Description: Rearrange columns in Excel based on column header
Dim iRow As Long
Dim iCol As Long
Dim c As Range
Dim col As Long
Application.DisplayAlerts = False
On Error Resume Next
Sheets("CostCode_import").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'Constant values
data_sheet1 = ActiveSheet.Name
target_sheet = "CostCode_import" '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 = "CostCode_import"
Application.DisplayAlerts = False
On Error Resume Next

Application.DisplayAlerts = False

'Delete unecessary rows

With Sheets(data_sheet1)

If Sheets(data_sheet1).Range("A1").Value = "" Then Sheets(data_sheet1).Rows("1:5").Delete .Columns("A:A").Delete

End With

Application.DisplayAlerts = True
'Start organizing columns
col = 1
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 = "Tccess CostCode" Then TargetCol = 1
If Sheets(data_sheet1).Cells(1, iCol).Value = "Project NTme" Then TargetCol = 2
If Sheets(data_sheet1).Cells(1, iCol).Value = "Cost code Id" Then TargetCol = 3
If Sheets(data_sheet1).Cells(1, iCol).Value = "GlobTl ID" Then TargetCol = 4
If Sheets(data_sheet1).Cells(1, iCol).Value = "Cost code Id" Then TargetCol = 5
If Sheets(data_sheet1).Cells(1, iCol).Value = "GlobTl ID" Then TargetCol = 6
If Sheets(data_sheet1).Cells(1, iCol).Value = "Cost code NTme" Then TargetCol = 7
If Sheets(data_sheet1).Cells(1, iCol).Value = "Tccounting System" Then TargetCol = 8

'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, col)
col = col + 1
End If
Next iCol 'Move to the next column until all columns are read

'Clean up

ActiveSheet.UsedRange.ClearFormats

End Sub

Open in new window

Does this help?

Luis Diaz

ASKER

Thank you for your comment.

The idea is not to remove the empty data but transfer the information twice as it is specified in the if statetement.
Column 3 and 5 should have information related to Cost code Id
Column 4 and 6 should have informatoin related to GlobTl ID

At the end I should have 8 columns with values however if I launch your code I have just 6 columns with values.

Thank you again for your help.

Roy Cox

I'm not sure if this is the correct results, I've made a few changes to the code
Move-columns.xlsm

Roy Cox

This is not good, if the wrong sheet is active then the code will not work correctly, which sheet should be active

data_sheet1 = ActiveSheet.Name

Open in new window

Maybe this will be better

Option Explicit
Sub move_columns_CostCode_import()


' Description: Rearrange columns in Excel based on column header
    Dim data_sheet1 As String, target_sheet As String
    Dim iRow As Long, iCol As Long, TargetCol As Long
    Dim c As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("CostCode_import").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    'Constant values
    data_sheet1 = "Input"
    target_sheet = "CostCode_import"    '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 = "CostCode_import"
    On Error Resume Next

    Application.DisplayAlerts = False

    'Delete unecessary rows

    With Sheets(data_sheet1)

        If .Range("A1").Value = "" Then .Rows("1:5").Delete
        .Columns("A:A").Delete


    Application.DisplayAlerts = True
    'Start organizing columns
    For iCol = 1 To .Range("A1").CurrentRegion.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 .Cells(1, iCol).Value = "Tccess CostCode" Then TargetCol = 1
        If .Cells(1, iCol).Value = "Project NTme" Then TargetCol = 2
        If .Cells(1, iCol).Value = "Cost code Id" Then TargetCol = 3
        If .Cells(1, iCol).Value = "GlobTl ID" Then TargetCol = 4
        If .Cells(1, iCol).Value = "Cost code Id" Then TargetCol = 5
        If .Cells(1, iCol).Value = "GlobTl ID" Then TargetCol = 6
        If .Cells(1, iCol).Value = "Cost code NTme" Then TargetCol = 7
        If .Cells(1, iCol).Value = "Tccounting System" Then TargetCol = 8

        '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
            .Range("a1").CurrentRegion.Columns(iCol).Copy Destination:=Sheets(target_sheet).Cells(1, TargetCol)
        End If
    Next iCol    'Move to the next column until all columns are read

    End With
    'Clean up

    ActiveSheet.UsedRange.ClearFormats

End Sub

Open in new window

Subodh Tiwari (Neeraj)

I think you should show the desired output on CostCode_import Sheet so that we know that what output you are expecting exactly.

The problem with your current code is your TargetCol will always catch the first column header and hence will replace the old copied column in the destination sheet.

Subodh Tiwari (Neeraj)

Since you haven't replied yet, give the following code a try to see if this is what you are trying to achieve.

Sub move_columns_CostCode_import()


' Description: Rearrange columns in Excel based on column header
    Dim data_sheet1 As String, target_sheet As String
    Dim iRow As Long, iCol As Long, TargetCol As Long, col As Long
    Dim c As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("CostCode_import").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    'Constant values
    data_sheet1 = "Input"
    target_sheet = "CostCode_import"    '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 = "CostCode_import"
    On Error Resume Next

    Application.DisplayAlerts = False

    'Delete unecessary rows
    Sheets(data_sheet1).Activate
    With Sheets(data_sheet1)

        If .Range("A1").Value = "" Then
            .Rows("1:5").Delete
            .Columns("A:A").Delete
        End If

    Application.DisplayAlerts = True
    'Start organizing columns
    For iCol = 1 To .Range("A1").CurrentRegion.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 .Cells(1, iCol).Value = "Tccess CostCode" Then
            TargetCol = iCol
        ElseIf .Cells(1, iCol).Value = "Project NTme" Then
            TargetCol = iCol
        ElseIf .Cells(1, iCol).Value = "Cost code Id" Then
            TargetCol = iCol
        ElseIf .Cells(1, iCol).Value = "GlobTl ID" Then
            TargetCol = iCol
        ElseIf .Cells(1, iCol).Value = "Cost code Id" Then
            TargetCol = iCol
        ElseIf .Cells(1, iCol).Value = "GlobTl ID" Then
            TargetCol = iCol
        ElseIf .Cells(1, iCol).Value = "Cost code NTme" Then
            TargetCol = iCol
        ElseIf .Cells(1, iCol).Value = "Tccounting System" Then
            TargetCol = iCol
        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
            .Range("a1").CurrentRegion.Columns(iCol).Copy Destination:=Sheets(target_sheet).Cells(1, iCol)
        End If
    Next iCol    'Move to the next column until all columns are read

    End With
    'Clean up

    ActiveSheet.UsedRange.ClearFormats

End Sub

Open in new window

Roy Cox

Or maybe

Option Explicit
Sub move_columns_CostCode_import()


' Description: Rearrange columns in Excel based on column header
    Dim data_sheet1 As String, target_sheet As String
    Dim iRow As Long, iCol As Long, TargetCol As Long
    Dim iX As Integer
    '    Dim c As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("CostCode_import").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    'Constant values
    data_sheet1 = "Input"
    target_sheet = "CostCode_import"    '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 = "CostCode_import"
    On Error Resume Next

    Application.DisplayAlerts = False

    'Delete unecessary rows

    With Sheets(data_sheet1)

        If .Range("A1").Value = "" Then .Rows("1:5").Delete
        .Columns("A:A").Delete


        Application.DisplayAlerts = True
        'Start organizing columns
        For iCol = 1 To .Range("A1").CurrentRegion.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 .Cells(1, iCol).Value = "Tccess CostCode" Then TargetCol = 1
            If .Cells(1, iCol).Value = "Project NTme" Then TargetCol = 2
            If .Cells(1, iCol).Value = "Cost code Id" Then
                For iX = 1 To 2
                    TargetCol = Choose(iX, 3, 5)
                    .Range("a1").CurrentRegion.Columns(iCol).Copy Destination:=Sheets(target_sheet).Cells(1, TargetCol)
                Next iX
            End If
            If .Cells(1, iCol).Value = "GlobTl ID" Then TargetCol = 4
            If .Cells(1, iCol).Value = "Cost code Id" Then TargetCol = 5
            If .Cells(1, iCol).Value = "GlobTl ID" Then TargetCol = 6
            If .Cells(1, iCol).Value = "Cost code NTme" Then TargetCol = 7
            If .Cells(1, iCol).Value = "Tccounting System" Then TargetCol = 8

            '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
                .Range("a1").CurrentRegion.Columns(iCol).Copy Destination:=Sheets(target_sheet).Cells(1, TargetCol)
            End If
        Next iCol    'Move to the next column until all columns are read

    End With
    'Clean up

    ActiveSheet.UsedRange.ClearFormats

End Sub

Open in new window

I don't think you use the Range variable c

Luis Diaz

ASKER

@Roy_Cox this your last code works however I need to inegrate the

For iX = 1 To 2
TargetCol = Choose(iX, 3, 5)
.Range("a1").CurrentRegion.Columns(iCol).Copy Destination:=Sheets(target_sheet).Cells(1, TargetCol)
Next iX
End If

For Field "GlobTl ID" as I need to have it in column 4 and 6 as it is done for "Cost code Id".

Thank you again for your help.

Luis Diaz

ASKER

@sktneer with your code I am not able to get the columns data as specified in my file example.

Luis Diaz

ASKER

Please find attached the result that I am looking for:
Move-columns-2.xlsm

Subodh Tiwari (Neeraj)

What you have shown on CostCode_import sheet is your desired output?

Luis Diaz

ASKER

Yes it is.

Roy Cox

Add another For Loop

Option Explicit

Sub move_columns_CostCode_import()


' Description: Rearrange columns in Excel based on column header
    Dim data_sheet1 As String, target_sheet As String
    Dim iRow As Long, iCol As Long, TargetCol As Long
    Dim iX As Integer
    '    Dim c As Range
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("CostCode_import").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    'Constant values
    data_sheet1 = "Input"
    target_sheet = "CostCode_import"    '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 = "CostCode_import"
    On Error Resume Next

    Application.DisplayAlerts = False

    'Delete unecessary rows

    With Sheets(data_sheet1)

        If .Range("A1").Value = "" Then .Rows("1:5").Delete
        .Columns("A:A").Delete


        Application.DisplayAlerts = True
        'Start organizing columns
        For iCol = 1 To .Range("A1").CurrentRegion.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 .Cells(1, iCol).Value = "Tccess CostCode" Then TargetCol = 1
            If .Cells(1, iCol).Value = "Project NTme" Then TargetCol = 2
            If .Cells(1, iCol).Value = "Cost code Id" Then
                For iX = 1 To 2
                    TargetCol = Choose(iX, 3, 5)
                    .Range("a1").CurrentRegion.Columns(iCol).Copy Destination:=Sheets(target_sheet).Cells(1, TargetCol)
                Next iX
            End If
             If .Cells(1, iCol).Value = "GlobTl ID" Then
                For iX = 1 To 2
                    TargetCol = Choose(iX, 4, 6)
                    .Range("a1").CurrentRegion.Columns(iCol).Copy Destination:=Sheets(target_sheet).Cells(1, TargetCol)
                Next iX
            End If
            If .Cells(1, iCol).Value = "GlobTl ID" Then TargetCol = 4
            If .Cells(1, iCol).Value = "Cost code Id" Then TargetCol = 5
            If .Cells(1, iCol).Value = "GlobTl ID" Then TargetCol = 6
            If .Cells(1, iCol).Value = "Cost code NTme" Then TargetCol = 7
            If .Cells(1, iCol).Value = "Tccounting System" Then TargetCol = 8

            '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
                .Range("a1").CurrentRegion.Columns(iCol).Copy Destination:=Sheets(target_sheet).Cells(1, TargetCol)
            End If
        Next iCol    'Move to the next column until all columns are read

    End With
    'Clean up

    ActiveSheet.UsedRange.ClearFormats

End Sub

Open in new window

Luis Diaz

ASKER

Yes I thought the same however I don't get the result that I want look the Last Column of CostCode import which doesn't match with the one reported in the code.

Thank you for your help.
Move-columns-3.xlsm

Roy Cox

I'll have another look later. Does the new attachment have the desired results in?

Subodh Tiwari (Neeraj)

Okay try this to see if you get the desired output now.

I have followed completely different approach, see if this works for you.

Sub move_columns_CostCode_import()

' Description: Rearrange columns in Excel based on column header
Dim Sws As Worksheet, Dws As Worksheet
Dim iRow As Long
Dim col As Long, lc As Long

Application.DisplayAlerts = False

On Error Resume Next
Sheets("CostCode_import").Delete
On Error GoTo 0

Application.DisplayAlerts = True
'Constant values
Set Sws = Sheets("Input")
iRow = Sws.UsedRange.Rows.Count 'Determine how many rows are in use
'Create a new sheet to store the results
Worksheets.Add.Name = "CostCode_import"
Set Dws = Sheets("CostCode_Import")
Application.DisplayAlerts = False
On Error Resume Next

Application.DisplayAlerts = False
'Delete unecessary rows

With Sws
    If Sws.Range("A1").Value = "" Then Sws.Rows("1:5").Delete .Columns("A:A").Delete
End With

Application.DisplayAlerts = True
'Start organizing columns

If WorksheetFunction.CountIf(Sws.Rows(1), "Tccess CostCode") > 0 Then
    lc = Dws.Cells(1, Columns.Count).End(xlToLeft).Column
    If Dws.Range("A1") = "" Then
        lc = 1
    Else
        lc = lc + 1
    End If
    col = WorksheetFunction.Match("Tccess CostCode", Sws.Rows(1), 0)
    Sws.Range(Sws.Cells(1, col), Sws.Cells(iRow, col)).Copy Dws.Cells(1, lc)
End If

If WorksheetFunction.CountIf(Sws.Rows(1), "Project NTme") > 0 Then
    lc = Dws.Cells(1, Columns.Count).End(xlToLeft).Column
    If Dws.Range("A1") = "" Then
        lc = 1
    Else
        lc = lc + 1
    End If
    col = WorksheetFunction.Match("Project NTme", Sws.Rows(1), 0)
    Sws.Range(Sws.Cells(1, col), Sws.Cells(iRow, col)).Copy Dws.Cells(1, lc)
End If

If WorksheetFunction.CountIf(Sws.Rows(1), "Cost code Id") > 0 Then
    lc = Dws.Cells(1, Columns.Count).End(xlToLeft).Column
    If Dws.Range("A1") = "" Then
        lc = 1
    Else
        lc = lc + 1
    End If
    col = WorksheetFunction.Match("Cost code Id", Sws.Rows(1), 0)
    Sws.Range(Sws.Cells(1, col), Sws.Cells(iRow, col)).Copy Dws.Cells(1, lc)
End If

If WorksheetFunction.CountIf(Sws.Rows(1), "GlobTl ID") > 0 Then
    lc = Dws.Cells(1, Columns.Count).End(xlToLeft).Column
    If Dws.Range("A1") = "" Then
        lc = 1
    Else
        lc = lc + 1
    End If
    col = WorksheetFunction.Match("GlobTl ID", Sws.Rows(1), 0)
    Sws.Range(Sws.Cells(1, col), Sws.Cells(iRow, col)).Copy Dws.Cells(1, lc)
End If

If WorksheetFunction.CountIf(Sws.Rows(1), "Cost code Id") > 0 Then
    lc = Dws.Cells(1, Columns.Count).End(xlToLeft).Column
    If Dws.Range("A1") = "" Then
        lc = 1
    Else
        lc = lc + 1
    End If
    col = WorksheetFunction.Match("Cost code Id", Sws.Rows(1), 0)
    Sws.Range(Sws.Cells(1, col), Sws.Cells(iRow, col)).Copy Dws.Cells(1, lc)
End If

If WorksheetFunction.CountIf(Sws.Rows(1), "GlobTl ID") > 0 Then
    lc = Dws.Cells(1, Columns.Count).End(xlToLeft).Column
    If Dws.Range("A1") = "" Then
        lc = 1
    Else
        lc = lc + 1
    End If
    col = WorksheetFunction.Match("GlobTl ID", Sws.Rows(1), 0)
    Sws.Range(Sws.Cells(1, col), Sws.Cells(iRow, col)).Copy Dws.Cells(1, lc)
End If

If WorksheetFunction.CountIf(Sws.Rows(1), "Cost code NTme") > 0 Then
    lc = Dws.Cells(1, Columns.Count).End(xlToLeft).Column
    If Dws.Range("A1") = "" Then
        lc = 1
    Else
        lc = lc + 1
    End If
    col = WorksheetFunction.Match("Cost code NTme", Sws.Rows(1), 0)
    Sws.Range(Sws.Cells(1, col), Sws.Cells(iRow, col)).Copy Dws.Cells(1, lc)
End If

If WorksheetFunction.CountIf(Sws.Rows(1), "Tccounting System") > 0 Then
    lc = Dws.Cells(1, Columns.Count).End(xlToLeft).Column
    If Dws.Range("A1") = "" Then
        lc = 1
    Else
        lc = lc + 1
    End If
    col = WorksheetFunction.Match("Tccounting System", Sws.Rows(1), 0)
    Sws.Range(Sws.Cells(1, col), Sws.Cells(iRow, col)).Copy Dws.Cells(1, lc)
End If
    
'Clean up
Dws.UsedRange.ClearFormats
End Sub

Open in new window

Move-columns-v3.xlsm

Luis Diaz

ASKER

@Roy_Cox: Nop it contains in CostCode_import the result after I launch your code.

Please find attached how I want the data in CostCode_import result sheet.
Move-columns-4.xlsm

Luis Diaz

ASKER

@sktneer:Your code works, thank you again for your help.

I see in your code that you repeat multiple times the same statement

ex:

If WorksheetFunction.CountIf(Sws.Rows(1), "GlobTl ID") > 0 Then
    lc = Dws.Cells(1, Columns.Count).End(xlToLeft).Column
    If Dws.Range("A1") = "" Then
        lc = 1
    Else
        lc = lc + 1
    End If

Open in new window

Wouldn't be intersting to simplify the code and make another Generic sub in order to passing argument:

Something like that (an example of another question):

The generic sub in order to pass arguments

Sub DoIndexMatch(Target As Range, matchvalue As Range, comparedvalue As Range, DestinationColumn As String)
    Dim c As Range
    For Each c In matchvalue
        If IsNumeric(Application.Match(c, comparedvalue, 0)) Then
            Range(DestinationColumn & c.Row) = Application.WorksheetFunction.Index(Target, Application.WorksheetFunction.Match(c, comparedvalue, 0), 0)
        End If
    Next c
End Sub

Open in new window

Then I call the Sub and i place my arguments ex:

Actions that to Run

Sub RunIndexMatch()
    DoIndexMatch Range("ccprojectstable!v2:v" & Rows.Count), Range("E2", Range("E" & Rows.Count).End(xlUp)), Range("ccprojectstable!A2:A" & Rows.Count), "B"
    DoIndexMatch Range("accountingtable!F2:F" & Rows.Count), Range("E2", Range("E" & Rows.Count).End(xlUp)), Range("accountingtable!A2:A" & Rows.Count), "O"
End Sub

Open in new window

Thank you very much for your help.

Subodh Tiwari (Neeraj)

Yes you are correct, that could also be done with a function call.
Actually devoted too much of time to understand the logic and came with this while trying to tweak your own code so made the changes during runtime. :)

Glad something worked for you at last.

ASKER CERTIFIED SOLUTION

Subodh Tiwari (Neeraj)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Luis Diaz

ASKER

It works, thank you again for your useful help!

Subodh Tiwari (Neeraj)

You're welcome LD!