Vba 选择和粘贴单元格

我对VBA比较陌生，我对Python只有一些经验，对查看其他VBA宏并根据需要调整它们的经验很少，所以我正在尽我所能

我要做的是，对于粘贴在工作表B（工作表B，A行）中的每个零件号，我想从包含所有零件号的不同工作表（工作表D，A行）中找到相同的零件号，并将说明（工作表D，H行）从工作表D复制到另一列（工作表B，D行）然后检查该行中的下一个零件号并重复

目前我遇到的错误是“编译错误：没有if的Else”，很抱歉我不是很精通，但是如果有任何帮助，我将不胜感激

其他资料：

-我要在工作表B中搜索的零件号，B列是从工作表A中填写的，只需将其设为=A即可！B2或=串联（A！B2）

子描述（）
将wsA标注为工作表、wsB标注为工作表、wsC标注为工作表、wsD标注为工作表
变暗Rng As范围
设置wsB=工作表（“B”）
设置wsD=工作表（“D”）
Do:aRow=2
如果wsB.Cells（aRow，2）“，则
带有工作表（“D”）。范围（“A:A”）
x=wsB.单元（aRow，2）
Set Rng=.Find（What:=x_
之后：=.Cells（.Cells.Count）_
LookIn:=xlValues_
看：=xlother_
搜索顺序：=xlByRows_
SearchDirection:=xlNext_
匹配案例：=假）
选择，复制
wsB.单元格（dRow，2）.粘贴
卓尔=卓尔+1
其他的
aRow=aRow+1
循环直到wsB.Cells（aRow，2）=“”
端接头

再次感谢

编辑：当前错误是无法在中断模式下执行代码

Sub Description()
Dim wsA As Worksheet, wsB As Worksheet, wsC As Worksheet, wsD As Worksheet
Dim Rng As Range
Set wsB = Worksheets("B")
Set wsD = Worksheets("D")
aRow = 2
dRow = 2

    Do:
        If wsB.Cells(aRow, 1) <> "" Then
            With Worksheets("D").Range("A:A")
                Set Rng = .Find(What:=wsB.Cells(aRow, 1), _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                Rng.Copy
                Rng.Offset(0, 3).Paste (Cells(aRow, 4))
                dRow = dRow + 1
                aRow = aRow + 1
            End With
        End If
    Loop Until wsB.Cells(aRow, 1) = ""
End Sub

子描述（）
将wsA标注为工作表、wsB标注为工作表、wsC标注为工作表、wsD标注为工作表
变暗Rng As范围
设置wsB=工作表（“B”）
设置wsD=工作表（“D”）
aRow=2
卓尔=2
做：
如果wsB.Cells（aRow，1）“，则
带有工作表（“D”）。范围（“A:A”）
Set Rng=.Find（What:=wsB.Cells（aRow，1）_
之后：=.Cells（.Cells.Count）_
LookIn:=xlValues_
看：=xlother_
搜索顺序：=xlByRows_
SearchDirection:=xlNext_
匹配案例：=假）
收到
Rng.偏移量（0，3）.粘贴（单元格（aRow，4））
卓尔=卓尔+1
aRow=aRow+1
以
如果结束
循环直到wsB.Cells（aRow，1）=“”
端接头

如果

aRow=aRow+1

之后的下一行中出现

结束，您是否可以尝试将
结束。有关语法，请参见MSDN.microsoft.com/en us/library/752y8abs.aspx，在Excel中，我们通常将垂直范围称为列，将水平范围称为行。
根据您的代码和问题描述，我假设您所说的“A行”是A列。
此外，您的代码还可以扫描wsB.Cells（aRow，2）。它是B列而不是A列。
无论如何，这只是一个小问题

以下代码将检查工作表B第B列的单元格。如果找到相同的值
在工作表D的A列中，则工作表D的H列中的响应单元格将
复制到工作表B的B列中的单元格

Option Explicit
Sub Description()
   Dim wsB As Worksheet, wsD As Worksheet, aRow As Long
   Dim rngSearchRange As Range, rngFound As Range
   Set wsB = Worksheets("B")
   Set wsD = Worksheets("D")
   Set rngSearchRange = wsD.Range("A:A")
   aRow = 2
   Do While wsB.Cells(aRow, 2).Value <> ""
      Set rngFound = rngSearchRange.Find(What:=wsB.Cells(aRow, 2).Value, LookAt:=xlWhole)
      If Not rngFound Is Nothing Then
         wsD.Cells(rngFound.Row, 8).Copy Destination:=wsB.Cells(aRow, 4)  ' Indexes of Column H, D are respectively 8, 4
      End If
      aRow = aRow + 1
   Loop
End Sub

选项显式
子说明（）
将wsB设置为工作表，将wsD设置为工作表，尽可能长
变暗RNG搜索范围作为范围，RNG查找范围作为范围
设置wsB=工作表（“B”）
设置wsD=工作表（“D”）
设置rngSearchRange=wsD.Range（“A:A”）
aRow=2
Do While wsB.Cells（aRow，2）.Value“”
设置rngFound=rngSearchRange.Find（What:=wsB.Cells（aRow，2）.Value，LookAt:=xlWhole）
如果不是，那么rngFound什么都不是
wsD.Cells（rngFound.Row，8）.Copy Destination:=wsB.Cells（aRow，4）’列H、D的索引分别为8、4
如果结束
aRow=aRow+1
环
端接头
以下是对我有效的方法

Sub Description()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("B").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    Dim foundRng As Range
    For Each rng In Sheets("B").Range("B2:B" & LastRow)
        Set foundRng = Sheets("D").Range("A:A").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundRng Is Nothing Then
            Sheets("B").Cells(rng.Row, "D") = Sheets("D").Cells(foundRng.Row, "H")
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

我认为，在
Else
之前直接以
结尾也是必要的。实际上，最好用。。。以
块外的
结束，用于。。。下一步
循环，因为它没有被for中的任何内容重新定义。。。下一个，是的。在VBA中，多行语句require
End***
我将aRow和dRow定义放在Do:之上，这样它就不会在每次循环时重置它谢谢！这对我来说非常接近，一个问题是它没有找到项目，而只是按顺序粘贴它们，所以如果我有12个项目，它会从工作表D粘贴前12个。它是否会检查工作表B而不是D，以便每次都匹配并从工作表D粘贴？
Sub Description()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("B").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    Dim foundRng As Range
    For Each rng In Sheets("B").Range("B2:B" & LastRow)
        Set foundRng = Sheets("D").Range("A:A").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
        If Not foundRng Is Nothing Then
            Sheets("B").Cells(rng.Row, "D") = Sheets("D").Cells(foundRng.Row, "H")
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub