Guten Morgen Sofie!
Also eigentlich sieht der Code gut aus. Du hast allerdings unter das Set ergebnis gleich deinen Kopierbefehl eingetragen. Das könnte zu Problemen führen. Denn wenn ein Wert nicht gefunden wird, ist ergebnis = nothing und dafür gibt es keine Zeile und Spalte. Dann kommt der Fehler. Wenn so was wieder kommt und du nicht weißt woran es liegen könnte, in den Code reingehen und dann mit F8 zeilenweise durchgehen. Damit wird jede Zeile einzeln ausgeführt und irgendwann kommt dann die Meldung. Dann weißt du, welche Zeile Probleme macht. Also die Zeile muss raus - das kopieren kommt ja schon im if Vergleich. Habe dir den Code mal noch leicht geändert. Er sucht jetzt in der kompletten Spalte A (a steht jetzt statt cells - columns (1). Die suche ist übrigens beendet wenn er das erste Ergebnis findet. Also wenn dann nochmal Tafeln 87g - 100g kommt ignoriert er dass. Beim kopieren habe ich auch deinen Quellbereich auf Reihe und Spalte angepasst. Dein Ziel hat gepasst. Ich habe auch noch eine ApplicationScreenupdatin eingefügt. Das bewirkt, das auf dem Bildschirm nicht von Ziel auf Quelle etc. umgeschaltet wird. Der Schirm ist also bis zum MakroEnde eingefroren und aktualisiert sich wenn er fertig ist. Sieht jetzt so aus.
Option Explicit
Sub Kunden_Aktionspläne_einfügen()
'
' Kunden_Aktionspläne_einfügen Makro
'
' Tastenkombination: Strg+r
'
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"
'
'Quelldatei öffnen
Workbooks.Open Filename:=pfad & quelle
'
'Wert suchen und kopieren
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
Also ich würde den Code nicht aufblähen. Mit einer schönen Schleife kannst du alles machen. Und das koppeln der Daten ist auch kein Problem. Weiß jetzt aber nicht, wie deine Eintragungen sind und was, wann wie gesucht werden soll. Aber wenn du alles in einer Art Tabelle in einem Blatt hast (kann man auch in den Code schon mit eintragen) lässt sich das super auswerten.
Viele Grüße Matthias
PS: Das mit dem Süßen war lieb gemeint aber in der Weihnachtszeit gibt es schon genug Süßes. :-) Mit reicht schon, wen ich helfen kann und es dann bei Dir läuft.
|