Question

我有一个工作簿，其中包含两个名为Datadump的工作簿，其中第1行和第1行中包含标题，而A和A列中包含描述性数据。 B和C列中的数据。我想复制此数据并将其粘贴到工作表＆＃34; 因素＆＃34;中。

此工作表在第2行上有列标题，在A列和A列中有相同的描述性标题。 B.我想将＆＃34; Datadump＆＃34; 中的数据粘贴到E列中＆＃34; Factors＆＃34; 中的相同行标签上。

但是，＆＃34;因素＆＃34; 会有一些不在＆＃34; Datadump＆＃34; 的行，所以它需要粘贴相关的行。我尝试了各种不起作用的代码。下面是最新的，但在pastespecial行上出现Runtime 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

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

1 个答案: