从一个工作表复制数据并粘贴到另一个工作表中的相关行

Question

我有一个包含两张工作表的工作簿，其中一张名为 Datadump，第 1 行为 headers，A 列和 B 列为站点和描述性数据，C 列为数据。我想复制并粘贴这些数据在工作表“因素”中。

此工作表的第 2 行有 headers 列，A 列和 B 列的描述性标题相同。我想粘贴来自 "Datadump"[=24= 的数据] 针对 E 列 "Factors" 中的相同行标签。

但是，"Factors"会有一些行不在"Datadump"中，所以需要粘贴针对相关行。 我尝试了各种无效的代码。下面是最新的，但在 pastespecial 行上出现运行时 1004 错误。 如果有人可以提供帮助，那就太好了。

谢谢

'VARIABLE NAME                 'DEFINITION
Dim SourceSheet As Worksheet    'The data to be copied is here
Dim TargetSheet As Worksheet    'The data will be copied here
Dim ColHeaders As Range         'Column headers on Target sheet
Dim MyDataHeaders As Range      'Column headers on Source sheet

Dim DataBlock As Range          'A single column of data
Dim c As Range                  'a single cell
Dim Rng As Range                'The data will be copied here (="Place holder" for the first data cell)
Dim i As Integer

Set SourceSheet = Sheets("Datadump")
Set TargetSheet = Sheets("Factors")

With TargetSheet
    Set ColHeaders = .Range("A2:E2")
    Set Rng = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
End With

With SourceSheet
    Set MyDataHeaders = .Range("A1:C1")

    For Each c In MyDataHeaders
        If Application.WorksheetFunction.CountIf(ColHeaders, c.value) = 0 Then
            MsgBox "Can't find a matching header name for " & c.value & vbNewLine & "Make sure the column names are the same and try again."
            Exit Sub
        End If
    Next c

    Set DataBlock = .Range(.Cells(2, 3), .Cells(.Rows.Count, 1).End(xlUp))
    Set Rng = Rng.Resize(DataBlock.Rows.Count, 1)

    For Each c In MyDataHeaders
        i = Application.WorksheetFunction.Match(c.value, ColHeaders, 0)
        Set c = DataBlock
        If Not c Is Nothing Then
            .Columns(c.Column).Copy
            c.PasteSpecial xlPasteValues
        End If
    Next
    Application.CutCopyMode = False
End With

End Sub

Answer 1

下面的代码将完成这项工作，

For i = 2 To 100 'considering 100 rows in Datadump sheet
    site1 = Sheets("Datadump").Cells(i, 1).Value
    desc1 = Sheets("Datadump").Cells(i, 2).Value
    For j = 3 To 50 'considering 50 rows in Factors sheet
        site2 = Sheets("Factors").Cells(j, 1).Value
        desc2 = Sheets("Factors").Cells(j, 2).Value
        If site1 = site2 And desc1 = desc2 Then
            Sheets("Factors").Cells(j, 5).Value = Sheets("Datadump").Cells(i, 3).Value
        End If
    Next j
Next i