时间戳

首页 > 解决方案 > 如何根据值excel VBA将多行复制到特定单元格中的另一张表

vba - 如何根据值excel VBA将多行复制到特定单元格中的另一张表

问题描述

对不起，我想问一下如何根据值将多行复制到特定单元格中的另一张纸上

所以我得到了 2 张第一张是“RawData”

RawData

  A      B       C       D

1 test1  test2   test3   test4
2 A-001  SP-001  Anne    America
3 A-002  SP-001  Chris   America
4 A-003  SP-002  Kenth   Dutch
5 A-004  SP-001  Keith   Dutch
6 A-005  SP-003  Lia     America

我想复制包含第二张“报告”单元格“A1”中的值的行，例如在“报告”范围 A1 中包含值 SP-001 和包含 SP-001 的行复制到“报告”中的 B4 "

Report

    A        B       C        D        E       F
1   SP-001
2
3            test1   test2    test3    test4
4            A-001   SP-001   Anne     America
5            A-002   SP-001   Chris    America
6            A-004   SP-001   Keith    Dutch

我尝试使用 vba

Sub tgr()

    Dim rngFound As Range
    Dim strFirst As String
    Dim strID As String
    Dim i As Long

    i = 3

    strID = Worksheets("test1").Range("A1").Value


    Set rngFound = Columns("B").Find(strID, Cells(Rows.Count, "B"), xlValues, xlWhole)
    If Not rngFound Is Nothing Then
        strFirst = rngFound.Address
        Do
            If LCase(Cells(rngFound.Row, "B").Text) = LCase(strID) Then

                'Found a match
                'MsgBox rngFound.Row
                 Worksheets("test").Range("A" & rngFound.Row & ":" & "D" & rngFound.Row).Copy Worksheets("test1").Range("E" & i + 1)

            End If
            Set rngFound = Columns("B").Find(strID, rngFound, xlValues, xlWhole)
        Loop While rngFound.Address <> strFirst
    End If

    Set rngFound = Nothing

End Sub

但它总是复制最后一行包含 SP-001 并且根本不循环，即使我已经用 msgbox 检查了该行及其循环

先感谢您

标签： vbaexcelcopy-paste

解决方案

你可以使用AutoFilter()：

Private Sub main()
    Dim repSht As Worksheet
    Set repSht = Worksheets("Report")

    With Worksheets("RawData")
        With .Range("D1", .Cells(.Rows.Count, "A").End(xlUp))
            .AutoFilter field:=2, Criteria1:=repSht.Range("A1").Value2
            With Intersect(ActiveSheet.UsedRange, .EntireColumn).Resize(.Rows.Count - 1).Offset(1, 0)
                If CBool(Application.Subtotal(103, .Cells)) Then .SpecialCells(xlCellTypeVisible).Copy repSht.Range("b4")
            End With
        End With
    End With
End Sub

推荐阅读