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

VBA从具有2个条件的2个excel文件复制,vba,excel,Vba,Excel,我只想在名称不存在时将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:\Desktop\Source.xlsm") Set y

我只想在名称不存在时将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:\Desktop\Source.xlsm")
Set y = Workbooks.Open(" P:\Desktop\Destination.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:\Desktop\Source.xlsm")
Set sourceSheet = sourceWb.Worksheets("Sheet name in here")
Set destWb = Workbooks.Open(" P:\Desktop\Destination.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

我添加了注释来解释代码中发生了什么-如果您对其中任何一个都不确定,请添加注释

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:\Desktop\Source.xlsm")
Set sourceSheet = sourceWb.Worksheets("Sheet name in here")
Set destWb = Workbooks.Open(" P:\Desktop\Destination.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

查找方法:基本上是在Source.xlsm中的A列中逐行查找(例如,使用for循环),然后检查是否可以在destination.xlsm中找到此名称。如果没有,您就写它,否则您就转到下一行并再次检查…另外,为了将名称写入目标,最好使用类似
y.Sheets(“bla”).Range(“bla”).Value=x.Sheets(“aaa”).Range(“aaa”).Value
的内容,而不是复制粘贴。如果您真的只想要名称(其他列中没有任何内容),那么这是最简单的方法(代码方面)可以是复制所有内容,然后。这假设列中已经没有要保留的重复名称。但是如何循环通过source.xlxs中的这些单元格并影响到destination.xlsx中的值?如果activesheet.cells(i,1).value=?源xlsx中的单元格..如何继续?您想查看范围。查找方法:基本上是在source.xlsm的A列中逐行查找(例如,使用for循环),并检查是否可以在destination.xlsm中找到此名称。如果不能找到,请将其写入,否则请转到下一行并再次检查…此外,要将名称写入destination,最好使用类似于
y.Sheets(“bla”).Range(“bla”).Value=x.Sheets(“aaa”).Range(“aaa”)的内容.Value
而不是复制粘贴。如果您确实只需要名称(其他列中没有任何内容),请使用最简单的方法(按代码)可以是复制所有内容,然后。这假设列中已经没有要保留的重复名称。但是如何循环通过source.xlxs中的这些单元格并影响到destination.xlsx中的值?如果activesheet.cells(i,1).value=?源xlsx中的单元格..我如何继续?谢谢您的帮助,但是当我执行代码时,什么也没有发生。错误消息如下:destWb已经打开,我将取消所有修改,因为在这里,当我放置代码vba时。我如何编辑它?@DaveSince脚本包含打开两个工作簿的命令,如果其中任何一个都已打开,则会失败。只需注释掉2个
工作簿。如果两个文件都已打开,则打开
行。但是,将不会定义destWb
Set destWb=workbook(“Destination.xlsm”)
将为已打开的工作簿设置引用。您需要对
Source.xlsm执行同样的操作,谢谢您的帮助,但当我执行代码时,什么也不会发生。错误消息如:destWb已打开,我将取消所有修改,因为在这里,当我放置代码vba时。我如何编辑它?@DaveSince脚本包含打开两个工作簿的命令,如果其中任何一个已经打开,脚本将失败。只需注释掉2个
工作簿。如果两个文件都已打开,请打开
行。但是,将不会定义destWb
Set destWb=工作簿(“Destination.xlsm”)
将为已打开的工作簿设置引用。您需要对
Source.xlsm执行相同的操作