搜索工作簿以获取单元格值并复制整行和标题

时间:2017-08-11 08:27:07

标签: excel-vba vba excel

我已经尝试了所有可能的方法来搜索并找到此问题的解决方案,但无济于事,我的问题是在工作簿中的不同工作表中搜索特定单元格值并将整行与其标题一起复制(每个工作表有不同的标题示例,Lab1,名称,日期,实验室测试类型,LabType N,名称,日期,测试类型等)并循环直到找到最后一个值及其各自的标题。在这方面的任何帮助将受到高度赞赏,请原谅我不知道正确的方式提出问题,因为我完全是这个论坛的新手。 下面的代码给出了搜索单元格的结果,但是因为每个搜索结果都有自己的标题,我没有得到结果,因为它只是通过循环而不是它们的标题粘贴整个单元格行。 这是一个例子。
Sheet2在范围A1中具有名称日期年龄性别单元格无测试类型:F1
Sheet3具有名称日期年龄性别单元格无测试类型2 X射线范围A1:G1
Sheet4具有姓名日期年龄性别细胞无测试类型3 XRay ECG A1:H1

Option Explicit
Option Compare Text '< ignore case
Sub AllRecordSearchMacroForPhone()
    Dim FirstAddress As String
    Dim c As Range, Sheet As Worksheet
    Dim rng As Range
    Set rng = Range("D1")
    If rng = Empty Then Exit Sub
    For Each Sheet In Sheets
        If Sheet.Name <> "Sheet1" Then
            With Sheet.Columns(5)
                Set c = .find(rng, LookIn:=xlValues, LookAt:=xlWhole)
                If Not c Is Nothing Then
                    FirstAddress = c.Address
                    Do
                        c.EntireRow.Copy _
                              Destination:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                        Set c = .FindNext(c)
                    Loop Until c.Address = FirstAddress
                End If
            End With
        End If
    Next Sheet
    Set c = Nothing
End Sub

1 个答案:

答案 0 :(得分:0)

在代码中添加标记行:

If Not c Is Nothing Then
  >>Sheet.Rows(1).Copy Destination:=Sheets("Sheet1").Range("A" & Sheets("Sheet1").Rows.Count).End(xlUp).Offset(1, 0)
    FirstAddress = c.Address