Copying columns from one workbook/worksheet to another

[clmitche223]

Hi all,

I have two workbooks (Updated and New) and a worksheet in each (both called Report) and I need to copy columns from (New, Report) that match (Updated, Report) appending them to each matching column. I need to accomplish this using VBA.

Ex:
Workbook: Updated Workbook: New
Worksheet: Report Worksheet: Report
Column Titles: Name, Address, Telephone Column Titles: Name, Zip, Email, Address

The columns in workbook New can be in any different order and the title cells can contain different titles. I won't know what titles or what order they will be in but if the title cell in both workbooks match, I need to copy the entire column from workbook New and append it to the appropriate column in workbook Updated. I have all the code necessary to open each workbook and do the remaining processing, but I just can't figure out the code for copying and appending the appropriate columns.

I hope this makes sense and someone can help me.

Thanks a lot!

 

[vijay.vizzu]

Dear clmitche223

First of all, please upload a sample for better understand

Next one is, i think you can update the data with the help excel built in functions like Vlookup, Index+match and other functions.

 

[SirJB7]

Hi, clmitche223!

As a new user you might want to (I'd say should and must) read this:
http://chandoo.org/forum/forums/new-users-please-start-here.14/

And regarding your issue, try this procedure:

Option Explicit

Sub IDontKnowIfWritingThisInCobolOrInPLI()
    '
    ' constants
    '  files
    Const ksUpdatedPath = ""
    Const ksUpdatedWB = "Libro1.xlsx"
    Const ksUpdatedWS = "Report"
    Const kiUpdatedTitle = 1
    Const ksUpdatedColumns = ",a,b"
    Const ksNewPath = ""
    Const ksNewWB = "Libro2.xlsx"
    Const ksNewWS = "Report 2"
    Const kiNewTitle = 2
    Const ksNewColumns = ",a and x,b xor y"
    '  others
    Const ksSeparator = ","
    '
    ' declarations
    Dim wbUpdated As Workbook, wbNew As Workbook
    Dim wsUpdated As Worksheet, wsNew As Worksheet
    Dim vUpdatedColumn As Variant, vNewColumn As Variant
    Dim I As Integer, J As Integer, K As Integer, bOk As Boolean
    '
    ' start
    Set wbUpdated = Workbooks.Open(ThisWorkbook.Path & ksUpdatedPath & Application.PathSeparator & ksUpdatedWB)
    Set wsUpdated = wbUpdated.Worksheets(ksUpdatedWS)
    Set wbNew = Workbooks.Open(ThisWorkbook.Path & ksNewPath & Application.PathSeparator & ksNewWB)
    Set wsNew = wbNew.Worksheets(ksNewWS)
    vUpdatedColumn = Split(ksUpdatedColumns, ksSeparator)
    vNewColumn = Split(ksNewColumns, ksSeparator)
    '
    ' process
    For I = 1 To UBound(vNewColumn)
        ' new column
        With wsNew.Rows(kiNewTitle)
            bOk = False
            J = 1
            Do Until bOk Or J = .Columns.Count
                If vNewColumn(I) = .Cells(1, J).Value Then
                    bOk = True
                Else
                    J = J + 1
                End If
            Loop
        End With
        ' updated column
        If bOk Then
            With wsUpdated.Rows(kiUpdatedTitle)
                bOk = False
                K = 1
                Do Until bOk Or K = .Columns.Count
                    If vUpdatedColumn(I) = .Cells(1, K).Value Then
                        bOk = True
                    Else
                        K = K + 1
                    End If
                Loop
            End With
        End If
        ' do the job
        If bOk Then
            Range(wsNew.Cells(kiNewTitle + 1, J), wsNew.Cells(wsNew.Rows.Count, J).End(xlUp)).Copy _
            wsUpdated.Cells(wsUpdated.Rows.Count, K).End(xlUp).Offset(1, 0)
        End If
    Next I
    '
    ' end
    '  save
    wbNew.Close False
    wbUpdated.Close True
    '  cleanup
    Set wsNew = Nothing
    Set wsUpdated = Nothing
    Set wbNew = Nothing
    Set wbUpdated = Nothing
    Beep
    '
End Sub

As I have a doubt regarding where you were going to place the asked code I decided to set up the worst scenario: your code will be run from a 3rd file that contains the macro. Discarding that you might have the code in the new file, if you'd have it in the updated file you should change the assignment of the object variable for it from:

    Set wbUpdated = Workbooks.Open(ThisWorkbook.Path & ksUpdatedPath & Application.PathSeparator & ksUpdatedWB)

to this:

    Set wbUpdated = ThisWorkbook

and maybe omit its closing:

    wbUpdated.Close True

or replace it by its saving:

    wbUpdated.Save

Despite you said that the worksheets will have the same name, and so will the columns but in different order, I setup the worst scenario too:
- different worksheet names
- different column names
- different title rows

At the beginning of the code, in the constants section you can define all the parameters, taking care in the column names constants (ksUpdatedColumn and ksNewColumn) to use this structure:
,col1[,col2...]
(aka ,col1,col2,col3...)
where the column names should not contain a "," comma. If so, replace it in the constant definitions by any other non used character and adjust properly the value of constant ksSeparator.
Take care of the 1st separator (",") since arrays start from position 0.

The procedure has a unique drawback, or not, depending on your requirments: it copies data from each column of new file at the end of related column of updated file, but if there're exist columns with different no. of rows in this last one, then the final output might be shifted. To fix this, you should provide more clues about your actual data.

Just advise if any issue.

Regards!

 

[Smallman]

clMitche223

Here is some basic code and a file to show how this sort of thing would happen in one file. If you want to extend it to the opened file then just change the sheet name and it should work fine.

Option Explicit
 
Sub MoveCols()
Dim ar As Variant
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim sh As Worksheet
 
Set sh = Sheet1
ar = Array("Name", "Address", "Telephone")
 
    For i = 0 To UBound(ar) 'Loop through the Array
    On Error Resume Next
        j = sh.Rows(1).Find(ar(i)).Column
        n = Sheet2.Rows(1).Find(ar(i)).Column
        sh.Columns(j).Copy Sheet2.Cells(1, n)
    Next i
    On Error GoTo 0
End Sub

To test change one of the headers in Sheet 1 to not match and you will see the data does not populate on Sheet2.

Hope this simplifies your problem.

Take care

Smallman

 

[clmitche223]

Thank you everyone. With a little modification to the above, I have it working. You're awesome!

 

[SirJB7]

Hi, clmitche223!
Glad you solved it. Thanks for your feedback and for your kind words too. And welcome back whenever needed or wanted.
Regards!