aus Sheet1 in Sheet2 kopieren

Sub vergleichen_übernehmen()
Dim vFile As Variant
Dim bRow, wksrow2 As Integer
Dim Cellwks1 As Range
Dim Cellwks2 As Range
Set wks1 = ActiveSheet
'Application.EnableEvents = False
'On Error GoTo ERRORHANDLER
vFile = Application.GetOpenFilename("Excel-Arbeitsmappe (*.xls), *.xls")
If vFile = False Then GoTo ERRORHANDLER
Workbooks.Open vFile
Set wkb2 = ActiveWorkbook
Set wks2 = ActiveSheet
For Each Cellwks1 In wks1.Range("A2:A100")
If Cellwks1.Value = "" Then GoTo SCHLIESSEN
For Each Cellwks2 In wks2.Range("A2:A100")
If Cellwks2.Value = "" Then Exit For
If Cellwks1.Value = Cellwks2.Value Then
'Lass ich wks2 und wks1 weg passiert alles nur in der ersten Arbeitsmappe
wks2.Range(Cells(Cellwks2.Row, 1), Cells(Cellwks2.Row, 25)).Copy
wks1.Range(Cells(Cellwks1.Row, 3), Cells(Cellwks1.Row,3)).PasteSpecial
End If
Next Cellwks2
Next Cellwks1
SCHLIESSEN:
wkb2.Close savechanges:=False
ERRORHANDLER:
'Application.EnableEvents = True
End Sub