在工作簿中搜索单元格值并复制整行和标题



我已经尝试了所有可能的方法来搜索并找到解决此问题的方法,但无济于事,我的问题是在工作簿的不同工作表中搜索特定的单元格值,并将整行及其标题一起复制(每个工作表都有不同的标题示例,Lab1,名称,日期,实验室测试类型,LabType N, 名称、日期、测试类型等(并循环访问,直到找到最后一个值及其各自的标头。在这方面的任何帮助将不胜感激,请原谅我不知道提出问题的正确方式,因为我完全是这个论坛的新手。 下面的代码为我提供了搜索单元格的结果,但是因为每个搜索结果都有自己的标题,我无法获得结果,因为它仅通过循环粘贴整行单元格,而不是它们的标题。 下面是示例。
表2 有 名称 日期 年龄 性别 细胞 范围 A1:F1
中没有测试类型 工作表 3 有 姓名 日期 年龄 性 细胞 没有 测试 类型2 X 射线范围 A1:G1 工作表 4 有 名称 日期 年龄 性爱细胞 没有测试类型 3 X射线心电图 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

在代码中添加标记行:

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

最新更新