Vba 当字符串匹配时，如何查找字符串关键字并将某些内容粘贴到它下面的行？

我对VBA很陌生。我正在尝试编写一个宏，该宏将在所有标题名称（第1行中的所有变量名称）中搜索“日期”，并将一个单元格（从另一个工作表）复制到找到匹配项的标题下的行（第2行）

粘贴部分目前不起作用，我让它搜索整个工作簿，因为我不知道如何将其设置为只搜索标题行

Sub FindAndPaste()

Dim Sheet As Worksheet
Dim Loc As Range

For Each Sheet In ThisWorkbook.Worksheets
    With Sheet.UsedRange
    Set Loc = .Cells.Find(What:="date")
    If Not Loc Is Nothing Then
        Do Until Loc Is Nothing
            Sheets("Sheet1").Range("L3").Copy
            Loc.Value.Offset(1, 0).PasteSpecial xlPasteAll
            Set Loc = .FindNext(Loc)
        Loop
    End If
End With
Set Loc = Nothing
Next
End Sub

我还尝试通过将Do Until循环中的部分更改为下面的代码来更改它，但这似乎也不起作用

Do Until Loc Is Nothing
    copiedval = Sheets("Sheet1").Range("L3").Copy
    Loc.Value.Offset(1, 0).Value = copiedval
    Set Loc = .FindNext(Loc)
Loop

---

如果不使用Find（）这将更简单

不清楚您是在查找包含日期的单元格，还是只查找值为“date”的单元格

或者是否要从搜索中排除Sheet1

Sub FindAndPaste()

    Dim Sheet, wb As workbook
    Dim c As Range, arrSheets

    Set wb = ThisWorkbook

    arrSheets = Array(wb.sheets("Sheet2"), wb.sheets("Sheet3"))

    For Each Sheet In arrSheets
        For Each c in Sheet.UsedRange.Rows(1).Cells
            If c.value like "*date*" Then
                wb.Sheets("Sheet1").Range("L3").Copy c.Offset(1,0)
                c.Offset(1,0).NumberFormat = "yyyy/mm/dd" '<<<<<<<<<EDIT 
            End If
        Next c
    Next
End Sub

Sub findandplaste（）
尺寸表，wb作为工作簿
尺寸c作为范围，角
设置wb=ThisWorkbook
arrSheets=数组（wb.sheets（“Sheet2”）、wb.sheets（“Sheet3”））
对于每一页中的每一页
对于Sheet.UsedRange.Rows（1）单元格中的每个c
如果c.值像“*日期*”那么
wb.图纸（“图纸1”）.范围（“L3”）.副本c.偏移量（1,0）
c、 Offset（1,0）.NumberFormat=“yyyy/mm/dd”如果不使用Find（）

不清楚您是在查找包含日期的单元格，还是只查找值为“date”的单元格

或者是否要从搜索中排除Sheet1

Sub FindAndPaste()

    Dim Sheet, wb As workbook
    Dim c As Range, arrSheets

    Set wb = ThisWorkbook

    arrSheets = Array(wb.sheets("Sheet2"), wb.sheets("Sheet3"))

    For Each Sheet In arrSheets
        For Each c in Sheet.UsedRange.Rows(1).Cells
            If c.value like "*date*" Then
                wb.Sheets("Sheet1").Range("L3").Copy c.Offset(1,0)
                c.Offset(1,0).NumberFormat = "yyyy/mm/dd" '<<<<<<<<<EDIT 
            End If
        Next c
    Next
End Sub

Sub findandplaste（）
尺寸表，wb作为工作簿
尺寸c作为范围，角
设置wb=ThisWorkbook
arrSheets=数组（wb.sheets（“Sheet2”）、wb.sheets（“Sheet3”））
对于每一页中的每一页
对于Sheet.UsedRange.Rows（1）单元格中的每个c
如果c.值像“*日期*”那么
wb.图纸（“图纸1”）.范围（“L3”）.副本c.偏移量（1,0）
c、 偏移量（1,0）。NumberFormat=“yyyy/mm/dd””试试这个

Sub FindAndPaste()

Dim sht As Worksheet
Dim Loc As Range, founds As Range
Dim firstAddress As String

For Each sht In ThisWorkbook.Worksheets
    Set founds = sht.Cells(2,1)
    With Intersect(sht.Rows(1), sht.UsedRange)
        Set Loc = .Find(What:="date", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not Loc Is Nothing Then
            firstAddress = Loc.Address
            Do
                Set founds = Union(founds, Loc)
                Set Loc = .FindNext(Loc)
            Loop While Not Loc.Address <>firstAddress
            Intersect(.Cells,founds).Offset(1).Value =Sheets("Sheet1").Range("L3").Value
        End If
    End With
Next sht

End Sub

Sub findandplaste（）
将sht变暗为工作表
Dim Loc作为范围，founds作为范围
将第一个地址设置为字符串
用于此工作簿中的每个sht。工作表
Set founds=短单元格（2,1）
带相交（第1行，第1行，第3行）
Set Loc=.Find（What:=“date”，LookIn:=xlValues，LookAt:=xlWhole，MatchCase:=False）
如果不是，那就什么都不是了
firstAddress=位置地址
做
Set founds=联合（founds，Loc）
设置Loc=.FindNext（Loc）
循环而不是Loc.Address firstAddress
相交（.Cells，founds）。偏移量（1）。值=图纸（“Sheet1”）。范围（“L3”）。值
如果结束
以
下一步
端接头

如果您需要查找包含“date”的标题，而不仅仅是将
LookAt:=xlother
替换为
LookAt:=xlPart

Sub FindAndPaste()

Dim sht As Worksheet
Dim Loc As Range, founds As Range
Dim firstAddress As String

For Each sht In ThisWorkbook.Worksheets
    Set founds = sht.Cells(2,1)
    With Intersect(sht.Rows(1), sht.UsedRange)
        Set Loc = .Find(What:="date", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not Loc Is Nothing Then
            firstAddress = Loc.Address
            Do
                Set founds = Union(founds, Loc)
                Set Loc = .FindNext(Loc)
            Loop While Not Loc.Address <>firstAddress
            Intersect(.Cells,founds).Offset(1).Value =Sheets("Sheet1").Range("L3").Value
        End If
    End With
Next sht

End Sub

Sub findandplaste（）
将sht变暗为工作表
Dim Loc作为范围，founds作为范围
将第一个地址设置为字符串
用于此工作簿中的每个sht。工作表
Set founds=短单元格（2,1）
带相交（第1行，第1行，第3行）
Set Loc=.Find（What:=“date”，LookIn:=xlValues，LookAt:=xlWhole，MatchCase:=False）
如果不是，那就什么都不是了
firstAddress=位置地址
做
Set founds=联合（founds，Loc）
设置Loc=.FindNext（Loc）
循环而不是Loc.Address firstAddress
相交（.Cells，founds）。偏移量（1）。值=图纸（“Sheet1”）。范围（“L3”）。值
如果结束
以
下一步
端接头

而如果您需要查找包含“date”的标题，而不仅仅是将
LookAt:=xlother
替换为
LookAt:=xlPart
Yesss！就是这样！谢谢你@Tim Williams我明白你将表1排除在搜索之外的意思了。实际上，我只需要它来浏览两个不同的工作表，所以我只复制了两次这个宏，并在一个宏中将工作表设置为工作表2，在另一个宏中将工作表设置为工作表3.Cells
不一定会返回Sheet1的实际第1行…@user3598756-我知道，但由于OP希望其标题位于第1行，因此在本例中，它应该返回。请参阅我的编辑-不遵循您希望对工作表名称执行的操作，但您不能在那里使用
//code>。是的！就是这样！谢谢你@Tim Williams我明白你将表1排除在搜索之外的意思了。实际上，我只需要它来浏览两个不同的工作表，所以我只复制了两次这个宏，并在一个宏中将工作表设置为工作表2，在另一个宏中将工作表设置为工作表3.Cells
不一定会返回Sheet1的实际第1行…@user3598756-我知道，但由于OP希望其标题位于第1行，因此在本例中，它应该返回。请参阅我的编辑-不遵循您希望对工作表名称执行的操作，但您不能在那里使用
//code>。。。