Option
Explicit
Sub
Aktionspläne_zusammenführen()
Dim
ziel
As
String
Dim
quelle
As
String
Dim
pfad
Dim
suche
Dim
ergebnis
pfad =
If
Right(pfad, 1) <>
"\" Then pfad = pfad & "
\"
ziel =
"2016 Aktionsplan Top Kategorien.xlsm"
quelle =
"16ABIL.xlsx"
suche =
"Tafeln 87g-100g"
Workbooks.Open Filename:=pfad & quelle
Set
ergebnis = Workbooks(quelle).Worksheets(1).Cells.Find(suche, LookIn:=xlValues)
If
Not
ergebnis
Is
Nothing
Then
Workbooks(quelle).Worksheets(1).Range(ergebnis.Row &
":"
& ergebnis.Row).Copy Destination:=Workbooks(ziel).Worksheets(1).Range(2 &
":"
& 2)
Application.CutCopyMode =
False
Workbooks(ziel).Activate
Else
MsgBox
"Es wurde nichts gefunden!"
End
If
Workbooks(quelle).Close savechanges:=
False
End
Sub