Question

我的目标工作簿（wb1）是一个范围为A1：Q740的表，并且具有标题行，我要从中复制的数据工作簿（wb2）始终具有相同的A：Q列和行数变化。

在两个工作簿中，大多数（但不是所有）行的A：F列中的数据都是相同的。我想比较两个工作表中的这些列，如果A：F中的给定行与另一个工作簿匹配，则将数据工作簿中G：Q列的该行数据复制到目标工作簿中具有匹配数据的行

我的问题是大多数情况下，两个工作簿之间的行不对齐。例如，在两个工作簿中，单元格A2：F2都匹配。但是，在工作簿的最下方，行会发散。在数据工作簿中，单元格A153：F153与目标工作簿单元格A159：F159相同。因此，在此示例中，我希望代码从单元格G2：Q2和G153：Q153复制数据，并将它们分别粘贴到单元格G2：Q2和G159：Q159中的目标工作簿中。

我已经命名了工作簿，工作表和范围，但是我不确定如何最好地进行比较或如何正确编写复制/粘贴目标。

编辑：更新了以下代码，直到第34行，然后才中断，因为匹配的数据不再位于每个工作簿中的同一行号中。

Option Explicit
Sub MergeWorksheets()

Dim wb1 As Workbook '2017 Tracking Report
Dim wb2 As Workbook 'Book# Drake Export from CSM
Dim Drake17 As Worksheet

Dim ImportDataFull As Range 'Full Range of Drake17 Export, less header row

Dim lastRow As Long 'Last Row of Drake17 Worksheet
Dim lastRow2 As Long 'Last Row of Drake Export

Dim ImportData As Range 'Drake Export Data
Dim DesImportData As Range 'Destination Range of Data for Compare

Dim DesImportRange As Range 'Destination for ImportRange

Set wb1 = Workbooks("2017 Tracking Report.xlsm")
Set wb2 = Workbooks(Workbooks.Count) 'Sets the most recently opened WB
Set Drake17 = wb1.Sheets("Drake17")

lastRow = Drake17.Range("A" & Rows.Count).End(xlUp).Row
Set DesImportData = Drake17.Range("A1:F" & lastRow)
Set DesImportRange = Drake17.Range("G1:Q" & lastRow)

wb2.Activate

lastRow2 = Range("A" & Rows.Count).End(xlUp).Row
Set ImportDataFull = Range("A1:Q" & lastRow2) 'Full Data Export Less Header Row
Set ImportData = Range("A1:F" & lastRow2) 'Sets range of data to compare

Dim r As Range
Dim i As Integer

With Columns(6)
    .NumberFormat = "m/d/yyy"
    .Value = .Value
End With

With Columns(2)
    .NumberFormat = "General"
    .Value = .Value
End With

Application.ScreenUpdating = False

For i = 2 To lastRow2

    With ImportDataFull
        Set r = Range("G" & i, "Q" & i)
            If ImportData.Cells(i, 1) = DesImportData.Cells(i, 1) And _
            ImportData.Cells(i, 2) = DesImportData.Cells(i, 2) And _
            ImportData.Cells(i, 3) = DesImportData.Cells(i, 3) And _
            ImportData.Cells(i, 4) = DesImportData.Cells(i, 4) And _
            ImportData.Cells(i, 5) = DesImportData.Cells(i, 5) And _
            ImportData.Cells(i, 6) = DesImportData.Cells(i, 6) Then
               r.Copy DesImportRange.Rows(i)
               r.EntireRow.HorizontalAlignment = xlCenter
            End If
    End With
Next i

Application.ScreenUpdating = True

End Sub

根据多个列条件复制部分行，并根据相同条件粘贴到行

0 个答案: