Excel VBA将匹配信息从一个工作表复制到另一个工作表

我试图让Excel中的宏工作。Excel VBA将匹配信息从一个工作表复制到另一个工作表

现在我有一个名为“Forms”的工作表，它有3列 - 标题（在第1行）是A =表格编号，B =表格名称，C =零件我也有一个名为Ins的工作表，相同的确切标题，并已填入信息。

我试图让它能够在列A中的“表单”中输入表单编号，并从Ins中自动为列B和C复制信息。我现在在代码中拥有EntireRow ，但我更喜欢它，如果我可以具体只复制到列A到C，但我想不出如何。

这是我目前尝试使用代码：

Private Sub Auto() 

Application.ScreenUpdating = False 
Dim wks1 As Worksheet, wks2 As Worksheet 

Dim j As Integer 
Dim i As Integer 

Set wks1 = Sheets("Forms") 
Set wks2 = Sheets("Ins") 

lastline = wks1.UsedRange.Rows.Count 

For i = 2 To lastline 

wks2.Cells(1, 1).CurrentRegion.AutoFilter 
wks2.Cells(1, 1).CurrentRegion.AutoFilter 1, wks1.Cells(i, 1).Value 
wks2.Cells(1, 1).CurrentRegion.EntireRow.Copy wks1.Cells(i, 1) 
wks2.Cells(1, 1).CurrentRegion.AutoFilter 


Next i 


End Sub

来源

2013-09-25 Amaress

我知道你想在'A'列中输入'表格名称'并自动填充'B'和'C'？ *'我现在在代码中拥有EntireRow，但是我更喜欢它，如果我可以专门将它复制到列A到C，但我想不出如何。“*您能否详细说明一下？ – 2013-09-25 15:57:07

工作表单元列A中每个表单只有一个实例吗？为什么你需要在VBA和循环中做到这一点？为什么不使用Vlookup或索引/匹配？ – user2140261

Tim在下面为我解决了EntireRow问题......现在我遇到的问题是只有标题被复制。我无法使用匹配，因为我需要将值复制到记录保存中，Ins中的值有时会更改 – Amaress

wks2.Cells(1, 1).CurrentRegion.Resize(,3).Copy wks1.Cells(i, 1)

编辑：这样的事情会更好，我觉得

Private Sub Auto() 

Application.ScreenUpdating = False 
Dim wks1 As Worksheet, wks2 As Worksheet 
Dim f As Range, frmNum 
Dim lastLine As Long 

Dim j As Integer 
Dim i As Integer 

Set wks1 = Sheets("Forms") 
Set wks2 = Sheets("Ins") 

lastLine = wks1.UsedRange.Rows.Count 

For i = 2 To lastLine 
    frmNum = wks1.Cells(i, 4).Value 
    If Len(frmNum) > 0 Then 
     Set f = wks2.Columns(1).Find(frmNum, LookIn:=xlValues, lookat:=xlWhole) 
     If Not f Is Nothing Then 
      f.Offset(0, 1).Resize(1, 9).Copy wks1.Cells(i, 5) 
     Else 
      wks1.Cells(i, 5).Value = "??" 
     End If 
    End If 
Next i 


End Sub

来源

2013-09-25 16:12:27

难道这只是一遍又一遍地复制头文件？ – user2140261

我没有仔细阅读这个问题，但我认为OP知道他们想要什么：如果'EntireRow'为他们工作，但他们不是复制整行，但只是前3列，那么我的答案就是这样... –

正在复制的标题是我遇到的问题之一。这虽然解决了我的EntireRow问题！谢谢！ – Amaress

这里更多的是对我的意思在我的评论中，如果你只是想要你所要求的，可以使用公式来完成它：

公式可能是：

B2 = =IF(A2<>"",VLOOKUP(A2,Ins!$A$1:$C$14,2,FALSE),"")

和

C2 = =IF(A2<>"",VLOOKUP(A2,Ins!$A$1:$C$14,3,FALSE),"")

如果宏工作表看起来是这样的：

enter image description here

然后你表格的工作表看起来像这样的公式拖下来后：

enter image description here

来源

2013-09-25 16:19:31 user2140261

这将工作，除了我需要他们复制，他们可以' t是可变的 – Amaress

我最终通过添加第三个工作簿并在列A中输入表单编号来完成此工作！

Private Sub Auto() 

Application.ScreenUpdating = False 
Dim wks1 As Worksheet, wks2 As Worksheet 

Dim j As Integer 
Dim i As Integer 

Set wks1 = Sheets("Form Worksheet") 
Set wks2 = Sheets("Instructions") 
Set wks3 = Sheets("To Do") 

lastline = wks1.UsedRange.Rows.Count 

For i = 2 To lastline 

wks2.Cells(2, 1).CurrentRegion.AutoFilter 
wks2.Cells(2, 1).CurrentRegion.AutoFilter 1, wks3.Cells(i, 1).Value 
wks2.Cells(2, 1).CurrentRegion.Offset(1).Resize(, 10).Copy 
wks1.Cells(i, 4).PasteSpecial Paste:=xlPasteValues 
wks2.Cells(2, 1).CurrentRegion.AutoFilter 


Next i 


End Sub

但我最终使用蒂姆的版本。

谢谢你们！

来源

2013-09-26 03:15:23 Amaress

Excel VBA将匹配信息从一个工作表复制到另一个工作表

回答

相关问题