Question

我需要在以下条件下将匹配数据从一个excel工作表复制到另一张工作表

在工作表1中匹配工作表2的EMP ID字段，如果找到值，则将整个记录值复制到工作表2。
尽管两页中的EMP ID，Email ID，电话号码和地址有不同的字段顺序，但VBA代码仍然可以工作
如果sheet2中有其他列而不是sheet1-中的列，那么从Sheet1复制匹配字段和值时，该列不应受到影响

我准备了以下脚本，当两个工作表中的EMP ID顺序相同时，即在工作表1和工作表2的第一栏中提供了EMP ID时，该脚本都可以工作但是如果我更改任何一个工作表或两个工作表中的EmP ID列的顺序都失败了

Sub CopyData()

    Dim shtImport As Worksheet
    Dim shtMain As Worksheet
    Set shtImport = ThisWorkbook.Sheets("Sheet2")
    Set shtMain = ThisWorkbook.Sheets("Sheet1")

    'From Main to Data
    Dim rngImpTitles As Range
    Set rngImpTitles = shtImport.Rows(1)
    Dim rngImpNames As Range
    Set rngImpNames = shtImport.Columns(1)

    Dim CopyColumn As Long
    Dim CopyRow As Long
    Dim foundRow As Long
    Dim foundCol As Long

    On Error Resume Next
    'for each column in row 1 of import sheet
    For CopyColumn = 2 To shtMain.Cells(1, shtMain.Columns.Count).End(xlToLeft).Column
        foundCol = rngImpTitles.Find(shtMain.Cells(1, CopyColumn).Value2).Column

        For CopyRow = 2 To shtMain.Cells(shtMain.Rows.Count, 1).End(xlUp).Row
            foundRow = rngImpNames.Find(shtMain.Cells(CopyRow, 1)).Row


            If Len(shtMain.Cells(CopyRow, CopyColumn)) <> 0 Then
                shtMain.Cells(CopyRow, CopyColumn).Copy shtImport.Cells(foundRow, foundCol)
            End If

            skip_row:
        Next CopyRow
        skip_title:
    Next CopyColumn

End Sub

将列标题和匹配的行从一个excel工作表复制到另一个

0 个答案: