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

Question

我试图让Excel中的宏工作。

现在我有一个名为＆＃34; Forms＆＃34;的工作表。有3列 - 标题（第1行）是A =表格编号，B =表格名称，C =部分 我还有一个名为Ins的工作表，它具有相同的标题，并且已经填充了信息。

我试图获取它以便我可以输入表格号码＆＃34; Forms＆＃34;在A列中，让Ins的信息自动复制到B列和C列。我现在在代码中有EntireRow，但我更喜欢它，如果我可以将它专门复制到A到C列，但我可以＆＃ 39;想想如何。

以下是我目前正在尝试使用的代码：

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

Answer 1

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

Answer 2

以下是我在评论中的意思，如果你只想要你所要求的，可以用公式来完成：

公式为：

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

和

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

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

然后，在拖动公式后，您的表单工作表将如下所示：

Answer 3

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

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

谢谢你们！