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

我正在尝试让Excel中的宏工作

现在我有一个名为“表格”的工作表，有3列——标题（第1行）是a=表格编号，B=表格名称，C=零件 我还有一个名为Ins的工作表，它有相同的确切标题，并且已经填充了信息

我正在尝试获取它，以便我可以在A列的“表单”上输入表单编号，并让Ins的信息自动复制到B列和C列。我现在有完整的代码，但我更希望它只复制到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

编辑：我想这样会更好

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

---

下面是我在评论中的更多意思，如果你只是想得到你想要的，可以使用公式来完成：

公式是：

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

B2==IF（A2“”，VLOOKUP（A2，Ins！$A$1:$C$14,2，FALSE），“”）

及

C2==IF（A2“”，VLOOKUP（A2，Ins！$A$1:$C$14,3，FALSE），“”）

如果您的工作表如下所示：

将公式向下拖动后，表单工作表将如下所示：

---

最后，我添加了第三个工作簿，并在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

但我最终还是用了蒂姆的版本

---

谢谢大家

我知道您想在

A

列中输入

formname

，并自动填充

B

和

C

<代码>我现在在代码中有EntireRow，但如果我能让它专门复制到A列到C列，我会更喜欢它，但我想不出怎么做。你能详细说明一下吗？在工作表ins的A列中每个表单只有一个实例吗？为什么需要在VBA和循环中执行此操作？为什么不使用Vlookup或Index/Match？Tim在下面为我解决了整个流程的问题。。。现在我遇到的问题是正在复制标题。我不能使用Match，因为我需要复制值来保存记录，Ins中的值有时会更改，这不是一次又一次地复制标题吗？我没有仔细阅读问题，但我假设OP知道他们想要什么：如果

EntireRow

对他们有效，但他们不是复制整行，而是只复制前3列，那么我的答案就是这样……只是复制过来的标题是我遇到的问题之一。这解决了我的整个流程问题！谢谢大家!@TimWilliams您知道如何更改宏以复制信息吗？当前，如果您输入表单编号并运行宏，则只需复制标题，有时还会复制底部某个表单的信息。这里有一个表单本身的链接：这可以工作，除非我需要它们复制过来，它们不能是可变的

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

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