Question

我实质上是想从sht1搜索一个关键字，将整个范围从sht1复制到sht2，并确保sht2开始从rowp 10粘贴。然后，循环应在sht1中搜索相同的关键字，并为sht2继续循环至rowp 11，直到循环结束。对于sht1来说还可以，但是将其粘贴到sht2上时，结果不是循环的，而是以某种方式获得相同的否。与sht1比较。不知道如何解决它。以下是我的代码。不胜感激一些建议=）

Sub shipshore()

Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim row As String
Dim rowp As String

row = 2
rowp = 10


Set wb = ThisWorkbook
Set sht1 = wb.Sheets("datasheet")
Set sht2 = wb.Sheets("Sheet1")

Do Until sht1.Range("G" & CStr(row)) = ""

If sht1.Range("F" & CStr(row)) = "abc" Then
Sheets("datasheet").Range("A" & CStr(row) & ":J" & CStr(row)).Copy

Sheets("Sheet1").Range("A" & CStr(rowp) & ":J" & CStr(rowp)).PasteSpecial _
Paste:=xlPasteValues



End If

row = row + 1
rowp = rowp + 1
Loop

End Sub

Answer 1

如果我正确理解您的需求，则仅在肯定匹配之后才应增加rowp，以便在sht2的前一行之后继续复制。尝试这种方式：

Sub shipshore()

Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim row As String
Dim rowp As String

row = 2
rowp = 10


Set wb = ThisWorkbook
Set sht1 = wb.Sheets("datasheet")
Set sht2 = wb.Sheets("Sheet1")

Do Until sht1.Range("G" & CStr(row)) = ""

  If sht1.Range("F" & CStr(row)) = "abc" Then
    Sheets("datasheet").Range("A" & CStr(row) & ":J" & CStr(row)).Copy

    Sheets("Sheet1").Range("A" & CStr(rowp) & ":J" & CStr(rowp)).PasteSpecial _
           Paste:=xlPasteValues
    rowp = rowp + 1    
  End If

  row = row + 1

Loop

End Sub

通过搜索和循环从一张纸复制并粘贴到另一张纸

1 个答案: