Excel VBA通​​過循環將匹配信息從一個工作表復制到另一個工作表

Question

我正在嘗試使Excel中的宏工作。

現在，我有一個名為“ 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

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),"")

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

然后，將公式向下拖動后，Forms工作表將如下所示：

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

但是我最終使用了Tim的版本。

多謝你們！