Поиск информации и добавление с другого листа

Question

Изображение

Изображение 1 Это формат, который люди будут заполнять, пример ищет 716

Изображение 2 Тогда формат 716, в который следует вставлять информацию, выглядит следующим образом (в нем уже есть информация)

Изображение 3 Добавление информации должно закончиться так (добавление информации под старой информацией вместо ее перезаписи)

У меня есть код, который ищет значение на другом листе, после поиска я хочу скопировать то, что на оригинальном листе ниже, в другие ячейки, но я хочу скопировать только то, что содержит информацию. Затем вернитесь к найденному значению и вставьте ниже последнюю ячейку с информацией.

Так как лист bancos имеет больше информации, код заменяет информацию, которая там находится, вместо этого я хотел бы, чтобы он поискал последнюю неиспользуемую ячейку 4 строки ниже 1 слева и начал поиск 10 строк также ниже и вставил информацию на листе BU.

Это новый формат, в котором всегда выполняется поиск ячейки "C3" и добавляется информация из "B7: C19"

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 "No se encontró, desea agregar la partida: " & Worksheets("BU").Range("C3").Value
            End If
        End With
    End If
End Sub

Нет сообщений MSG tho

Answer 1

ОК, я изменил пару строк, как указано ниже, которые, я надеюсь, решат ваши проблемы.

Private Sub C1_Click()

Dim Partida As String
Dim Rng As Range, r1 As Range, r2 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
                Set r2 = Rng.Offset(4, -1).End(xlDown)
                If r2.Row > 19 Then
                    Set r2 = Rng.Offset(4, -1)
                Else
                    Set r2 = r2.Offset(1)
                End If
                For Each r1 In Worksheets("Bu").Range("B7:B19")
                    If Len(r1) > 0 Then
                        r2.Resize(, 2).Value = r1.Resize(, 2).Value
                        Set r2 = r2.Offset(1)
                    End If
                Next r1
            Else
                MsgBox "No se encontró, desea agregar la partida: " & Worksheets("BU").Range("C3").Value
            End If
        End With
    End If
End Sub