Excel VBA 하나의 워크 시트에서 다른 워크 시트로 루프로 일치 정보 복사

Question

Excel에서 매크로를 가져 오려고합니다.

지금 당장 "Form"이라는 3 개의 열이있는 워크 시트가 있습니다 - 1 행의 제목은 A = 양식 번호, B = 양식 이름, C = 부품입니다. 또한 Ins이라는 워크 시트가 있습니다. 똑같은 표제와 이미 정보로 채워져있다.

"양식"열 A에 양식 번호를 입력하고 열 B와 C에 대한 정보를 자동으로 복사 할 수 있도록 가져 오려고합니다. 코드에서 지금 EntireRow가 있습니다. ,하지만 그것을 특별히 C에서 열 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("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),"") 

당신이 만약 인 워크 시트는 다음과 같습니다

수식을 아래로 드래그 한 후 다음 당신은 워크 시트는 다음과 같이됩니다 양식 :

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 버전을 사용하여 끝났습니다.

고마워요!