我想根据另一张纸上的值复制一行答案

【问题标题】：I want to copy a row based on the values from another sheet我想根据另一张纸上的值复制一行
【发布时间】：2017-03-17 19:20:10
【问题描述】：

我正在尝试编写一个宏，如果它具有 sheet2 的值，它将把整个行从表 1 复制到 sheet3。

例如，如果我在 sheet1 和 sheet2 中有以下内容

Sheet 1     Sheet 2   
Name DOJ    Name        
abc  123    def          
def  456    jkl          
ghi  789
jkl  101

那么我需要 sheet3 中的如下输出

Name  DoJ
def  456
Jkl  101

【问题讨论】：

请附上您正在“尝试编写”的代码，并告诉我们哪些地方无法正常工作，我们将能够为您提供帮助。（并且可能解释为什么你不能只做一个VLOOKUP。）
我认为我的编辑与您的编辑“冲突”，因此拒绝了您的编辑。如果您愿意，请随意回滚我的编辑并重新应用您的编辑。

标签： excel vba

【解决方案1】：

试试这个代码：

Sub Test()

 Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
 Dim Sr As Long, Lr1 As Long, Lr2 As Long, Lr3 As Long
 Dim i As Long
 Dim Rng As Range, fRng As Range

 Set Sh1 = Sheets("sheet1")
 Set Sh2 = Sheets("sheet2")
 Set Sh3 = Sheets("sheet3")

 Sr = 2
 Lr1 = Sh1.Range("A" & Sh1.Rows.Count).End(xlUp).Row
 Lr2 = Sh2.Range("A" & Sh2.Rows.Count).End(xlUp).Row
 Lr3 = Sh3.Range("A" & Sh3.Rows.Count).End(xlUp).Row + 1
 Set Rng = Sh1.Range("A" & Sr & ":A" & Lr1)

 For i = Sr To Lr2
  Set fRng = Rng.Find(Sh2.Range("A" & i).Value, , xlValues, xlWhole, xlByRows, xlNext)
  If Not fRng Is Nothing Then
   Sh3.Range("A" & Lr3 & ":B" & Lr3).Value = Sh1.Range("A" & fRng.Row & ":B" & fRng.Row).Value
   Lr3 = Lr3 + 1
  End If
 Next

End Sub

【讨论】：