Excel VBA Match Columns while Pasting

Question

I have small set of data in excel with 4 columns

File A: 

  SNO   TYPE  CountryA   CountryB   CountryD
    1    T1    A1          B2         D1          
    2    T2    A2          B2         D2

and i have this data in another excel file

File B:

   SNO   TYPE  CountryB  CountryA CountryC
    11    T10   B10         A10     C10
    22    T20   B20         A20     C20
    33    T30   B30         A30     C30

Now if i want to paste the data in file B over the data in file A, i want the column names to align automatically using some vba code.

So the End result should look like,

       SNO  TYPE CountryA    CountryB  CountryC  CountryD           
        1    T1   A1           B1         --         D1
        2    T2   A2           B2         --         D2 
        11   T10  A10          B10        C10        --
        22   T20  A20          B20        C20        --
        33   T30  A30          B30        C30        -- 

Answer 1

Match column coding

Sheet2 = Your original HEADERS ( Only required headers - Put them into row 1 )

Sheet1 = your data along with the headers but headers are not in sync which could be having more headers or less but you want your data as per the headings present in the sheet2

now put your data into sheet2 ( in row 2 ) below the headers which are already present into sheet2 and run the below coding and your data will appear as per the required headers.

Sub Rahul()


Dim Orig_Range As Range
Dim New_Range As Range
Dim ToMove As Range
Dim RowOld, RowNew As Long
Dim ColOld, ColNew As Long
Dim WSD As Worksheet
Dim Cname As String

Set WSD = ActiveSheet

ColOld = WSD.Cells(1, Application.Columns.Count).End(xlToLeft).Column

ColNew = WSD.Cells(2, Application.Columns.Count).End(xlToLeft).Column

RowNew = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row

RowOld = 1


Set Orig_Range = Range(WSD.Cells(1, 1), WSD.Cells(1, ColOld))



For i = 1 To ColOld

Set New_Range = Range(WSD.Cells(2, 1), WSD.Cells(2, ColNew))


Cname = Orig_Range.Cells(RowOld, i).Value

Set ToMove = New_Range.Find(what:=Cname, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=True)


If ToMove Is Nothing Then

New_Range.Cells(1, i).Resize(RowNew, 1).Select

Selection.Insert shift:=xlToRight




ElseIf Not ToMove.Column = i Then

ToMove.Resize(RowNew, 1).Select




Selection.Cut

New_Range.Cells(1, i).Select

Selection.Insert shift:=xlToRight

End If

Next i


End Sub

Answer 2

This should work for you:

Sub MatchUpColumnDataBasedOnHeaders()

Dim wbk As Workbook
Set wbk = ThisWorkbook
Set ws = wbk.Sheets(1)
Set ws2 = wbk.Sheets(2)
Dim cell As Range
Dim refcell As Range

Application.ScreenUpdating = False
ws.Select

    For Each cell In ws.Range("A1:Z1")

        cell.Activate
        ActiveCell.EntireColumn.Copy

        For Each refcell In ws2.Range("A1:Z1")
            If refcell.Value = cell.Value Then refcell.PasteSpecial (xlPasteValues)
        Next refcell

    Next cell
Application.ScreenUpdating = True

End Sub

It's funny, I have this feeling there is a really easy non-VBA way to do this - but I couldn't find the button for it on google. This will work for columns A to Z on sheets 1 and 2. This assumes your headers are in row 1.

EDIT - IN ADDITION:

I noticed that you wanted to do this with files and you didn't say anything about sheets. This is how you would do it with different workbooks:

Sub MatchUpColumnDataBasedOnHeadersInFiles()

Dim wbk As Workbook

Set wbk = ThisWorkbook

Workbooks.Open Filename:="C:\PasteIntoWorkbook.xlsx"
Set wbk2 = Workbooks("PasteIntoWorkbook.xlsx")

Set ws = wbk.Sheets(1)
Set ws2 = wbk2.Sheets(1)

Dim cell As Range
Dim refcell As Range

wbk.Activate

Application.ScreenUpdating = False

ws.Select

    For Each cell In ws.Range("A1:N1")

        wbk.Activate
        ws.Select

        cell.Activate
        ActiveCell.EntireColumn.Copy

        wbk2.Activate
        ws2.Select

        For Each refcell In ws2.Range("A1:N1")
            If refcell.Value = cell.Value Then refcell.PasteSpecial (xlPasteValues)
        Next refcell

    Next cell

ws2.Select
Range("A1").Select
wbk.Activate
ws.Select
Range("A1").Select

Application.ScreenUpdating = True

End Sub

So if were heart-set on working with different .xls files, then that is how yo would do that. You obviously would just need to adjust the file path to whatever your paste-into file would be.