Option
Explicit
Sub
Kunden_Aktionspläne_einfügen()
Dim
ziel
As
String
Dim
quelle
As
String
Dim
pfad
Dim
suche
Dim
ergebnis
Application.ScreenUpdating =
False
pfad =
"P:\KAM"
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).Columns(1).Find(suche, LookIn:=xlValues)
If
Not
ergebnis
Is
Nothing
Then
Workbooks(quelle).Worksheets(1).Rows(ergebnis.Row).Columns(
"B:BA"
).Copy Destination:=Workbooks(ziel).Worksheets(1).Rows(8).Columns(
"C:BB"
)
Application.CutCopyMode =
False
Workbooks(ziel).Activate
End
If
Workbooks(quelle).Close savechanges:=
False
Application.ScreenUpdating =
True
End
Sub