如何将找到的数据跨多张复制到指定范围？

Question

我再次向各位编码天才寻求帮助。结局如此接近，我可以尝到它的味道。需要注意的是，我对 VBA 编码非常陌生，在这个项目之前，我一生中从未编码过一天。因此，编码的细微差别对我来说相当陌生，而且我很有可能错过了一些非常明显的东西。

我的代码将读取第 1 行，查找特定条件，将其找到的列设置为可搜索范围，在该行中查找特定名称 (rs.Name)，偏移到旁边的 4 列并复制该数据。我现在需要它做的就是复制该数据后，将该数据粘贴到指定范围（PasteRange）中的相应工作表（rs.Name）上。除了实际的粘贴行为之外，我一切正常（它将复制，我在继续之前确认了这一点）。我不断收到“对象不支持此属性或方法”。我一直在寻找关于为什么会这样做的解释，我唯一的想法是我将范围设置得太早，以至于无法粘贴到。但我需要它在循环之前执行此操作，这样我就不必指定每张纸的范围（共有 28 张）。我看过一些使用 .copy 目标的示例，在我看来，我做得正确（再次可能会丢失一些明显的东西）。

我有一个函数，然后是我一直在研究的实际宏。可能存在多余的变量。我打算事后清理它。

Function WorksheetExists(WSName As String) As Boolean
    On Error Resume Next
    WorksheetExists = Worksheets(WSName).Name = WSName
    On Error GoTo 0
End Function

Sub FindData()

Dim shname As String
Dim rs As Worksheet
Dim SampleEnding As String
Dim rFind As Range, cFind As String
Dim ws As Worksheet
Dim wk As Workbook
Dim SampleLook As Range
Dim SampleFind As Range
Dim SampleFind2 As Range
Dim PasteRange As Range
Dim Name As String

Set wk = ThisWorkbook
Set PasteRange = Application.InputBox("What is the range you will be copying to? Ex. E2:H2", Type:=8)

Do Until WorksheetExists(shname)
shname = InputBox("Enter sheet name")

If StrPtr(shname) = 0 Then
MsgBox ("User Cancelled!")
Exit Sub

Else
If Not WorksheetExists(shname) Then MsgBox shname & " doesn't exist!", vbExclamation

End If

Loop

SampleEnding = Application.InputBox("What is the string of the data file you are using? Ex: *_1.D,* or *_2.D", Type:=2)

Set rFind = wk.Sheets(shname).Rows("1:1").Find(What:=SampleEnding, After:=wk.Sheets(shname).Range("XFD1"), LookIn:=xlValues, Lookat:=xlPart, _
    SearchOrder:=xlByRows, searchdirection:=xlNext, MatchCase:=False, SearchFormat:=False)

If rFind Is Nothing Then
    MsgBox "Value not found"
Else
    Debug.Print rFind.Column
    cFind = Split(wk.Sheets(shname).Cells(1, rFind.Column).Address(True, False), "$")(0)
    
End If

For Each rs In ThisWorkbook.Worksheets
   If rs.Name = "hexafluoroethane" Or rs.Name = "chlorotrifluoromethane" Or _
   rs.Name = "Trifluoromethane" Or rs.Name = "Octafluoropropane" Or rs.Name = "Difluoromethane" Or _
   rs.Name = "Pentafluoroethane" Or rs.Name = "Octafluorocyclobutane" Or rs.Name = "Fluoromethane" Or _
   rs.Name = "Tetrafluoroethylene" Or rs.Name = "Hexafluoropropene" Or rs.Name = "Trifluoroethane" _
   Or rs.Name = "hexafluoropropene oxide" Or rs.Name = "chlorodifluoromethane" Or rs.Name = "Tetrafluoroethane" Or rs.Name = "Decafluorobutane" _
   Or rs.Name = "Heptafluoropropane" Or rs.Name = "Octafluorocyclopentene" Or rs.Name = "Trichlorofluoromethane" Or rs.Name = "Dodecafluoro-n-pentane" _
   Or rs.Name = "Nonafluorobutane" Or rs.Name = "Tetradecafluorohexane" Or rs.Name = "Undecafluoropentane" Or rs.Name = "E1" _
   Or rs.Name = "Hexadecafluoroheptane" Or rs.Name = "Tridecafluorohexane" Or rs.Name = "Perfluorooctane" Or rs.Name = "Pentadecafluoroheptane" _
   Or rs.Name = "Heptadecafluorooctane" Or rs.Name = "E2" Then

Set SampleFind = Range(cFind & "6:" & cFind & "34").Find(rs.Name, LookIn:=xlValues)
    If Not SampleFind Is Nothing Then
        Set SampleFind2 = Range(SampleFind.Offset(0, 1), SampleFind.Offset(0, 4))
            If Not SampleFind2 Is Nothing Then
                wk.Sheets(shname).SampleFind2.Copy Destination:=wk.Sheets(rs.Name).PasteRange
            End If
    End If
    
End If

Next rs

End Sub

Answer 1

• 下面的代码不起作用。

  Sheets(..).Rangeobject

  不是正确的做法。

wk.Sheets(shname).SampleFind2.Copy Destination:=wk.Sheets(rs.Name).PasteRange

• 使用 Sheet 限定 Range 对象以避免任何歧义非常重要。默认情况下，如果代码位于标准模块中，则 Range 对象引用 ActiveSheet。

    Set SampleFind = wk.Sheets(shname).Range(cFind & "6:" & cFind & "34").Find(rs.Name, LookIn:=xlValues)
    If Not SampleFind Is Nothing Then
        Set SampleFind2 = Range(SampleFind.Offset(0, 1), SampleFind.Offset(0, 4))
        If Not SampleFind2 Is Nothing Then
            SampleFind2.Copy Destination:=wk.Sheets(rs.Name).Range(PasteRange.Address)
        End If
    End If