Tabellen vergleichen, kopieren best. Zellinhalte

Hallo, liebe Excel-Spezialisten !
Ich habe diesen Beitrag bereits gestern in´s Forum gestellt - leider habe ich keine einzige Antwort erhalten (war wahrscheinlich schon zu spät); deshalb versuch ich´s nochmal:
Ich bin auf der Suche nach einem Makro das folgendes machen sollte:
Ich habe eine Excelmappe mit vielen verschiedenen Sheets indem sich ein Sheet ("409") mit ca. 4000 Zeilen und Spalten(A-AI) befinden; in der Spalte A (geginnend mit A2) befinden sich ID´s.
In dieses Sheet möchte ich Werte aus anderen Excelmappen einlesen; diese Excelmappen aus denen ausgelesen werden soll, sollte man über eine Pfadauswahl ansteuern bzw. öffnen können, da sich diese Mappen in verschiedenen Laufwerken bzw. Verzeichnissen befinden. Die auszuwählende Mappe, enthält aber immer ein Sheet namens "export" aus dem ausgelesen werden soll.
Bsp.:
Mappe xy; Sheet"409":
A2: BX0052585
A3: TG0055878
A4: GH0025487
A5: ZK0022587
A6: BU0058478
A7: KP0054578
A8: RT0025654
.....
A2500 : UJ0059754
........
A4000: VW0011589
Mappe ZXB; Sheet"export":
A2: ZK0022587
A3: KP0054578
A4: UJ0059754
d.h. es sollen die zellinhalte von "export" B2 nach "409" Q5, und C2 nach R5; B3 nach Q7, C3 nach R7; B4 nach Q2500; u.s.w kopiert werden.
Kann mir da von euch jemand helfen; über Formeln ist das Problem, meiner Meinung nach nicht zu lösen; nach makros hab das Forum auch schon durchsucht, hab aber nix gefunden.
Kann mir jemand bitte helfen?
LG
Markus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Markus,
du hast Glück. Ich hatte ein ähnliches Problem zu einer anderen Frage beantwortet. Mit ein paar Modfikationen passt es für deinen Fall.
Das Makro solltest du entweder in ein Modul deiner Persönlichen Makroarbeitsmappe einfügen oder
in der Zieldatei mit dem Blatt "409".
Gruß
Franz

Sub Datenabgleich_Tab_409()
'Daten aus zwei Tabellen abgleichen per Schlüsselspalte
Dim wbQuelle As Workbook, wksQuelle As Worksheet, vAuswahl
Dim wbZiel As Workbook, wksZiel As Worksheet
Dim varSchluessel, lSpalteSchluessel As Long
Dim Zelle As Range, rBereich As Range
Dim ZeileQuelle As Long, ZeileZiel As Long
'Quelldatei auswählen
vAuswahl = Application.GetOpenFilename( _
FileFilter:="Excel (*.xls;*.xlsx;*.xlsb;*.xlsm),*.xls;*.xlsx;*.xlsb;*.xlsm", _
Title:="Bitte Datei mit Quelldaten auswählen")
If vAuswahl = False Then GoTo Beenden
'Tabelle in der Inhalte eingetragen werden sollen
Set wbZiel = ActiveWorkbook   ' oder = Workbooks("MappeZiel.xls") 'Name anpassen!
Set wksZiel = wbZiel.Worksheets("409") 'Name - anpassen
'Nr. der Schlüsselspalte in Zieldatei
lSpalteSchluessel = 1 'ggf Anpassen
With wksZiel
'Letzte Datenzeile in Zieltabelle Spalet A
ZeileZiel = .Cells(.Rows.Count, lSpalteSchluessel).End(xlUp).Row
'Beich mit ID-Nummern im Zielblatt
Set rBereich = .Range(.Cells(2, lSpalteSchluessel), .Cells(ZeileZiel, lSpalteSchluessel))
End With
'Tabelle mit ggf. neuen Daten
Set wbQuelle = Workbooks.Open(Filename:=vAuswahl, ReadOnly:=True)
Set wksQuelle = wbQuelle.Worksheets("Export")
Application.ScreenUpdating = False
With wksQuelle
lSpalteSchluessel = 1 'Spalte mit ID-Code in Quelldatei
For ZeileQuelle = 2 To .Cells(.Rows.Count, lSpalteSchluessel).End(xlUp).Row
'Such-Werte aus Zeile in Zieltabelle einlesen
varSchluessel = .Cells(ZeileQuelle, lSpalteSchluessel)
'Name in Bereich mit ID-Code in Zieltabelle suchen
Set Zelle = rBereich.Find(what:=varSchluessel, _
LookIn:=xlValues, lookat:=xlWhole)
If Zelle Is Nothing Then 'Code in Zieldatei nicht vorhanden
'do nothing - keine Daten übertragen
Else
'Daten in Zieltabelle übertragen
'export" B2 nach "409" Q5, und C2 nach R5, usw.
ZeileZiel = Zelle.Row
wksZiel.Cells(ZeileZiel, 17) = .Cells(ZeileQuelle, 2) 'Spalte B in Q eintragen
wksZiel.Cells(ZeileZiel, 18) = .Cells(ZeileQuelle, 3) 'Spalte C in R eintragen
'usw
End If
Next
End With
'Quelldatei wieder schließen
wbQuelle.Close savechanges:=False
Application.ScreenUpdating = True
MsgBox "Fertig!", vbInformation + vbOKOnly, "Datenabgleich"
Beenden:
Set wbQuelle = Nothing: Set wbZiel = Nothing: Set wksQuelle = Nothing: Set wksZiel = Nothing
Set Zelle = Nothing: Set rBereich = Nothing
End Sub

Sub Datenabgleich_Tab_409() 'Daten aus zwei Tabellen abgleichen per Schlüsselspalte Dim wbQuelle As Workbook, wksQuelle As Worksheet, vAuswahl Dim wbZiel As Workbook, wksZiel As Worksheet Dim varSchluessel, lSpalteSchluessel As Long Dim Zelle As Range, rBereich As Range Dim ZeileQuelle As Long, ZeileZiel As Long Dim strVerzAktuell As String strVerzAktuell = VBA.CurDir 'Aktuelles Verzeichnis merken 'ins Auswahlverzeichnis wechseln VBA.ChDir Path:="c:\alle daten\daten2010" 'Quelldatei auswählen vAuswahl = Application.GetOpenFilename( _ FileFilter:="Excel (*.xls;*.xlsx;*.xlsb;*.xlsm),*.xls;*.xlsx;*.xlsb;*.xlsm", _ Title:="Bitte Datei mit Quelldaten auswählen") If vAuswahl = False Then GoTo Beenden 'Tabelle in der Inhalte eingetragen werden sollen MsgBox "Fertig!", vbInformation + vbOKOnly, "Datenabgleich" Beenden: VBA.ChDir Path:=strVerzAktuell 'Aktuelles Verzeichnis wieder setzen Set wbQuelle = Nothing: Set wbZiel = Nothing: Set wksQuelle = Nothing: Set wksZiel = _ Nothing Set Zelle = Nothing: Set rBereich = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

Tabellen vergleichen, kopieren best. Zellinhalte

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabellen vergleichen, kopieren best. Zellinhalte

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread