在工作表中搜索单元格值，然后将相邻单元格复制到变量范围中

Question

我有几个 Excel 工作簿，每个工作簿都包含多张工作表。

我使用特定值（“James Smith”）在所有工作表中进行关键字搜索。 如果找到该值，那么我需要从该单元格位置偏移五列（即“找到的单元格”将始终位于 C 列某处，因此偏移量指向 H 列），然后选择/复制相邻行进入最终将粘贴到新工作表“masterSheet”中的范围。

问题是：

1. 这些工作表中的每个工作表中的单元格地址都会有所不同，因此每个工作表中的单元格地址都不相同
2. 当我尝试在下面设置FoundRange值时出现错误。

    'Search multiple workbooks, look only for sheetnames that begin with "Week of" and don't contain the word "old"
    
    If currentSheet.Name Like "*Week of*" And InStr(currentSheet.Name, "Old") = 0 Then
        'If currentSheet.Name Like "*Week of*" Then
                
        'Within the current sheet look for a cell that contains "James Smith"
        With currentSheet
                
            .Range("C:C").Columns.Select
                
            Set FoundCell = Selection.Find(What:="James Smith", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
              MatchCase:=False, SearchFormat:=False)
                
            'When "James Smith" is found in the current worksheet, get the cell address and offset from that cell location"
            OffsetCell = currentSheet.Range(FoundCell.Address).Offset(0, 5).Address
    
            'In Column "H" select the adjacent non-blank cells and copy into a range <line below where I define "FoundRange" is where I keep getting the "runtime error 424 object required error"
            Set FoundRange = Range(OffsetCell, OffsetCell.End(xlDown))

            For Each cell In currentSheet.Range(FoundRange)
                If Not IsEmpty(cell) Then
                    currentSheet.Range(cell.Address).Copy
                    masterSheet.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                    masterSheet.Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Format(CDate(Replace(Replace(currentSheet.Name, "Week of ", " "), ".", "/")), "mm/dd/yyyy")
                    masterSheet.Range("C" & Rows.Count).End(xlUp).Offset(0, -1) = "James Bradford"
                    currentSheet.Range(cell.Address).Offset(0, 1).Copy
                    masterSheet.Range("E" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                    currentSheet.Range(cell.Address).Offset(0, 2).Copy
                    masterSheet.Range("F" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                    currentSheet.Range(cell.Address).Offset(0, 3).Copy
                    masterSheet.Range("G" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                End If
            Next              
        End With
    End If

Answer 1

这行得通。 仅供参考...你有詹姆斯史密斯在寻找和詹姆斯布拉德福德在循环中。 我添加了一个母版表进行测试，所以去掉“设置母版表”行。

Sub RngTest()
'Search multiple workbooks, look only for sheetnames that begin with "Week of" and don't contain the word "old"

Set currentSheet = ActiveSheet
Set masterSheet = ActiveWorkbook.Sheets("MasterSheet")
If currentSheet.Name Like "*Week of*" And InStr(currentSheet.Name, "Old") = 0 Then
    'If currentSheet.Name Like "*Week of*" Then

        'Within the current sheet look for a cell that contains "James Smith"
        With currentSheet

        .Range("C:C").Columns.Select

        Set FoundCell = Selection.Find(What:="James Smith", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

        'When "James Smith" is found in the current worksheet, get the cell address and offset from that cell location"
        Set OffsetCell = currentSheet.Range(FoundCell.Address).Offset(0, 5)

         'In Column "H" select the adjacent non-blank cells and copy into a range <line below where I define "FoundRange" is where I keep getting the "runtime error 424 object required error"
         Set FoundRange = Range(OffsetCell, OffsetCell.End(xlDown))

                 For Each cell In FoundRange.Cells
                    If Not IsEmpty(cell) Then
                        currentSheet.Range(cell.Address).Copy
                        masterSheet.Range("D" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                        masterSheet.Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = Format(CDate(Replace(Replace(currentSheet.Name, "Week of ", " "), ".", "/")), "mm/dd/yyyy")
                        masterSheet.Range("C" & Rows.Count).End(xlUp).Offset(0, -1) = "James Bradford"
                        currentSheet.Range(cell.Address).Offset(0, 1).Copy
                        masterSheet.Range("E" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                        currentSheet.Range(cell.Address).Offset(0, 2).Copy
                        masterSheet.Range("F" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                        currentSheet.Range(cell.Address).Offset(0, 3).Copy
                        masterSheet.Range("G" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                    End If
                Next


        End With

    End If

结束子