Excel的VBA匹配列而粘貼

Question

我小套在Excel中的數據與4列

File A: 

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

和我有這個數據在另一個excel文件

File B: 

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

現在，如果我想要粘貼文件B中的數據覆蓋文件A中的數據，我希望列名使用某些vba代碼自動對齊。

所以，最終的結果應該是什麼樣子，

 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

這應該爲你工作：

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 

這很有趣，我也有這種感覺有一個非常簡單的非VBA的方式做這 - 但我無法找到它在谷歌上的按鈕。這將爲列工作到Z上表1和2這裏假設你的頭是在第1行

編輯 - 此外：

我注意到，你想要的文件和你這樣做沒有說任何關於牀單的事情。這是你將如何與不同的工作簿做到這一點：

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 

所以，如果是心臟，設置不同的.xls文件的工作，然後就是溜溜將如何做到這一點。你顯然只需要將文件路徑調整爲任何粘貼文件即可。

Answer 2

匹配列編碼

Sheet2中=你原來的報頭（只需要頭 - 將它放到第1行）

工作表Sheet1 =您的數據標題一起，但頭是不是在其中可以有更多的同步或者更少，但是您希望根據表單中存在的標題獲取數據2

現在將您的數據放入sheet2下面（第2行），該數據表已存在於sheet2中，並運行以下代碼並顯示數據根據所需的標題。

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