Question

我有一个代码，可以在另一个搜索框中搜索值，搜索之后，我想复制原始工作表在另一个单元格中的波纹管，但是我想复制具有信息的内容。然后返回找到的值，并在下面的单元格中粘贴信息。

在示例代码中，在sheets（“ bancos”）单元格= H6中找到了partida.value 我想在Sheets（“ Bu”）B7：C19中复制信息，并复制粘贴的波纹管表（“ bancos”）G13：h13

Private Sub C1_Click()
    Dim Partida As String
    Dim Rng As Range


    Partida = Worksheets("BU").Range("c3").Value
    If Trim(Partida) <> "" Then
        With Sheets("Bancos").Rows("6:6")
            Set Rng = .Find(What:=Partida, after:=.Cells(.Cells.Count), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
            If Not Rng Is Nothing Then
                Worksheets("Bu").Activate
                ActiveSheet.Range("b7:c19").Select
                'i want to copy only the filled cells in the range (b7:c19); the filled cells in b and c
                Selection.Copy
                Application.Goto Rng, True

                'I want to paste in the last cells with information within the right and below cells from the "rng" found in cells G and H
            Else
                MsgBox "Not found"
            End If
        End With
    End If

End Sub

没有错误消息

Answer 1

可以尝试一下吗？它未经测试，但至少应该使您接近。

Private Sub C1_Click()

Dim Partida As String
Dim Rng As Range, r1 As Range, r As Long, c As Long

Partida = Worksheets("BU").Range("c3").Value

If Trim(Partida) <> "" Then
    With Sheets("Bancos").Rows("6:6")
        Set Rng = .Find(What:=Partida, after:=.Cells(.Cells.Count), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        If Not Rng Is Nothing Then
            r = Rng.Row + 4
            c = Rng.Column - 1
            For Each r1 In Worksheets("Bu").Range("b7:c19")
                If Len(r1) > 0 Then
                    .Cells(r, c + r1.Column - 2).Value = r1.Value
                    r = r + 1
                End If
            Next r1
        Else
            MsgBox "Not found"
        End If
    End With
End If

End Sub

搜索范围内的最后信息以复制和粘贴

1 个答案: