使用vba将基于某个值的内容从图纸复制到另一个图纸，但该值正在被覆盖

有以下VBA代码，其中我试图根据项目（即A列）将美国、开发商和日期从“P1”表复制到“sheet2”

下面是我正在使用的代码，但我看到单元格中的值作为循环的一部分被覆盖，您能帮我吗

Sub transfer()
Dim i As Long, j As Long, n As Long, lastrow1 As Long, longrow2 As Long, lastrow3 As Long

Dim myname As String
lastrow1 = Sheets("P1").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lastrow1
myname = Sheets("P1").Cells(i, "A").Value

Sheets("sheet2").Activate
lastrow2 = Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row

For j = 2 To lastrow2
        If Sheets("sheet2").Cells(j, "A").Value = myname Then
        Sheets("P1").Activate
        Sheets("P1").Range(Cells(i, "B"), Cells(i, "D")).Copy
         Sheets("sheet2").Activate
         Sheets("sheet2").Range(Cells(j, "B"), Cells(j, "D")).Select
         ActiveSheet.Paste                

        End If    
       Next j

Application.CutCopyMode = False
Next i

Sheets("P1").Activate
Sheets("P1").Range("A1").Select            
End Sub

---

在VBA中使用

选择

、

复制

和

粘贴

选项不是很好的做法。尝试使用

值

。试着这样做：

Sub transfer()
Dim i As Long, j As Long, n As Long, lastrow1 As Long, longrow2 As Long, lastrow3 As Long

Dim myname As String
lastrow1 = Sheets("P1").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lastrow1
myname = Sheets("P1").Cells(i, "A").Value

Sheets("sheet2").Activate
lastrow2 = Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row

For j = 2 To lastrow2
        If Sheets("sheet2").Cells(j, "A").Value = myname Then
        Sheets("sheet2").Range(Cells(i, "B").Value = Sheets("P1").Range(Cells(i, "B").Value
        Sheets("sheet2").Range(Cells(i, "D").Value = Sheets("P1").Range(Cells(i, "D").Value

                       End If

       Next j

Application.CutCopyMode = False
Next i

End Sub

这并不是我想要的方式，但这应该与您的代码集成在一起。如果您想让我发布我将如何编写这个特定问题的代码，请随时提问。（事实上，我几天前刚为工作做了类似的事情）