excel - 搜索要复制和粘贴的范围内的最后信息

Question

我有一个代码可以在另一个 shett 中搜索一个值，搜索后我想复制原始工作表在另一个单元格中的内容，但我只想复制有信息的内容。然后返回找到的值并在最后一个单元格的下方粘贴信息。

在示例代码中，partida.value 位于 sheet("bancos") cell = H6 我想复制 Sheets("Bu") B7:C19 中的信息，并且它应该粘贴在下面的 sheet("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

没有错误消息

标签： excelvba

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