Thema Datum  Von Nutzer Rating
Antwort
30.11.2015 13:28:20 Sofie
NotSolved
30.11.2015 14:19:04 Gast36311
NotSolved
30.11.2015 15:03:42 Gast29887
NotSolved
30.11.2015 19:35:16 Gast61909
NotSolved
03.12.2015 15:26:46 Sofie
NotSolved
03.12.2015 17:46:57 Gast27361
NotSolved
04.12.2015 12:06:38 Sofie
NotSolved
04.12.2015 13:05:40 Sofie
NotSolved
Rot Suchfunktion und Kopieren
05.12.2015 11:14:02 Gast20768
NotSolved
05.12.2015 11:18:17 Gast76748
NotSolved

Ansicht des Beitrags:
Von:
Gast20768
Datum:
05.12.2015 11:14:02
Views:
779
Rating: Antwort:
  Ja
Thema:
Suchfunktion und Kopieren

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.


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
30.11.2015 13:28:20 Sofie
NotSolved
30.11.2015 14:19:04 Gast36311
NotSolved
30.11.2015 15:03:42 Gast29887
NotSolved
30.11.2015 19:35:16 Gast61909
NotSolved
03.12.2015 15:26:46 Sofie
NotSolved
03.12.2015 17:46:57 Gast27361
NotSolved
04.12.2015 12:06:38 Sofie
NotSolved
04.12.2015 13:05:40 Sofie
NotSolved
Rot Suchfunktion und Kopieren
05.12.2015 11:14:02 Gast20768
NotSolved
05.12.2015 11:18:17 Gast76748
NotSolved