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