|
Hey liebes Forum,
ich bin ein fast totaler Neuling im VBA-Land und habe mich mal an einem Problem versucht und wie sollte es auch anders sein, funktioniert es nicht. Daher dachte ich, ich versuche es hier mal. Vielleicht kann mir ja jmd. helfen. Zunächst mein Problem:
Ich habe 2 Tabellenblätter in 2 verschiedenen Dateien ("Datei 1" und "Datei 2"). In der ersten Datei sind in Zeile 3 ID's. In der zweiten Datei sind auch ID's und dazugehörig Daten in den jeweiligen Spalten. Nun möchte ich folgendes per Makro machen:
1. eine ID aus Datei 1 kopieren (es beginnt immer in Zelle B3)
2. in Datei 2 gehen
3. dort automatisch durch die Finden-Funktion die ID aus Datei 1 suchen (Anmerkung: es soll ausschließlich in Zeile 3 gesucht werden!!)
4. dann in der gefundenen Spalte mit dem Cursor in Zeile 6 gehen
5. von zeile 6 bis zur letzten beschriebenen zeile alles markieren und kopieren
6. wieder in Datei 1 zurück gehen
7. dort auch in zeile 6 springen und die Daten aus der Zwischenablage einfügen
Diese Schritte sollen so lang wiederholt werden bis die letzte ID in Datei 1 mit den dazugehörigen Daten aus Datei 2 "aufgefüllt" wurde. Außerdem will ich das Makro nicht nur auf eine "Datei 1" anwenden, d.h. es gibt verschiedene Dateien, die ich mit Daten aus Datei 2 befüllen möchte. Kann das auch irgendwie eingebaut werden?
Hier seht ihr mal meinen ersten Versuch... mit sicher vielen Fehler. Aber vielleicht habt ihr ja Ideen?!
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | Sub füllen1()
Dim ID As Integer
LetzteZeile = Range("B3").End(xlToLeft).Column = 1
For i = 2 To LetzteZeile
Cells(3, i).Value.Select
Selection.Copy
ID = Selection.Copy
Windows("Datei 2").Activate
Rows(1).Find(What:=ID, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(3, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Datei 2").Activate
Cells(6, i).Select
ActiveSheet.Paste
i = i + 1
Next i
End Sub
Also was meint ihr?
Viele Grüße und einen guten Wochenstart. :)
Steffi
|
|