Question

图片1这是人们会使用的格式，示例搜索716

图片2然后将信息粘贴到的716格式是这样的（它已经有信息了）

图像3添加信息应该像这样（将信息添加到旧信息下方而不是重写）

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

由于表bancos具有更多信息，因此代码将替换其中的信息，相反，我希望它在左侧1下方的4行中搜索最后一个未使用的单元格，并在下方也开始搜索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

没有错误消息

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

搜索信息并从另一个工作表添加

1 个答案: