从具有 2 个条件的 2 个 excel 文件中复制 VBA



我想将source.xlsm中A列上的名称复制到destination.xlsm,如果该名称不存在,则应将其写入destination.xlsm列的末尾。

我不知道如何继续代码

Sub Recopy()
Dim x As Workbook
Dim y As Workbook
dim Lastlign as integer 
'## Open both workbooks
Set x = Workbooks.Open("P:DesktopSource.xlsm")
Set y = Workbooks.Open(" P:DesktopDestination.xlsm")
'Now, copy 
x.Sheets("name of copying sheet").Range("A1").Copy
'Now, paste to y worksheet:
y.Sheets("sheetname").Range("A1").PasteSpecial
x.Close
End Sub

我添加了注释来解释此代码中发生的事情 - 如果您不确定其中任何一个,只需注释...

Sub Recopy()
Dim sourceWb As Workbook
Dim sourceSheet As Worksheet
Dim destWb As Workbook
Dim destLast As Integer
Dim destSheet As Worksheet
dim Lastlign as integer 
dim myLoop as Integer
'## Open both workbooks
Set sourceWb = Workbooks.Open("P:DesktopSource.xlsm")
Set sourceSheet = sourceWb.Worksheets("Sheet name in here")
Set destWb = Workbooks.Open(" P:DesktopDestination.xlsm")
Set destSheet = destWb.Worksheets("Sheet name in here")
' get the last line of the source sheet so we know how many rows to loop over
Lastlign = sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row
For myLoop = 1 to Lastlign ' start from 2 if you have a header in row 1
    sourceVal = sourceSheet.Range("A" & myLoop).Value
    With destSheet.Range("A:A")
        Set oFound = .Find(sourceVal)
        If oFound Is Nothing Then
           ' didn't locate the value in col A of destSheet
           ' find last populated row in destination sheet and add 1 for first empty row
           destLast = destSheet.Cells(destSheet.Rows.Count, 1).End(xlUp).Row + 1
           ' set value in destination sheet
           destSheet.Range("A" & destLast).Value = sourceVal 
        End If
    End With
Next
End Sub

最新更新