Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1480to1484
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen

Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen
22.03.2016 16:44:17
Markus
Hi Leute
Ich versuche gerade zwei Arbeitsmappen mittels VBA abzugleichen. In der ersten Mappe lasse ich per Makro dutzende Excel Dateien auswerten für ein Jahresergebnis und in der zweiten Mappe sollen diese Ergebnisse dann mit den Ergebnissen von den letzten Jahren verglichen werden. Das ganze sieht so aus, dass ich in Spalte A einen Mitgliedscode habe anhand dessen ich die zwei Mappen vergleichen möchte. Es kann nämlich sein, dass in Mappe 2 ein Mitglied nicht vorhanden ist und somit dort erst angelegt werden muss.
Wenn also Spalte A von Mappe 2 die gleiche Nummer enthaltet wie Spalte A von Mappe 1, dann sollen Werte aus den Spalten B und C aus Mappe 1 in die Spalten B und F von Mappe 2 eingetragen werden Wenn die Nummer aus Spalte A ungleich ist, dann soll in Mappe 2 eine weitere Zeile eingefügt werden und die Nummer in Spalte A und dann wieder B und C aus Mappe 1 in B und F in Mappe 2 eingetragen werden.
bisher hab ich das versucht so zu lösen, was leider nicht funktionierte:

Sub copy()
Dim i As Integer
i = 1
Workbooks.Open Filename:="C:\Users\Verein\Desktop\test2.xlsm", ReadOnly:=True
Do While ThisWorkbook.Sheets("Tabelle1").Cells(i, 1).Value  ""
If ThisWorkbook.Sheets("Tabelle1").Cells(i, 1) = ActiveWorkbook.Sheets("Tabelle1").Cells(i,  _
_
_
_
_
1) Then
ThisWorkbook.Sheets("Tabelle1").Cells(i, 2) = ActiveWorkbook.Sheets("Tabelle1").Cells(i, _
_
_
_
_
2)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 6) = ActiveWorkbook.Sheets("Tabelle1").Cells(i, _
_
_
_
_
3)
Else
Worksheets("Tabelle1").Rows.Insert
ThisWorkbook.Sheets("Tabelle1").Cells(i, 1) = ActiveWorkbook.Sheets("Tabelle1").Cells(i, _
_
_
_
_
1)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 2) = ActiveWorkbook.Sheets("Tabelle1").Cells(i, _
_
_
_
_
2)
ThisWorkbook.Sheets("Tabelle1").Cells(i, 6) = ActiveWorkbook.Sheets("Tabelle1").Cells(i, _
_
_
_
_
3)
End If
i = i + 1
Loop
End Sub

Vielen Dank für jede Hilfe.

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen
22.03.2016 17:04:50
Fennek
Hallo,
wie wäre es beide Datei zu öffnen und mit dem sverweis zu vergleichen?
Mfg

AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen
23.03.2016 08:46:54
Markus
Ja das hört sich schlüssig an aber dann bleibt immer noch das Problem, dass ich nur vorhandene Mitarbeiternummern vergleichen kann und wenn ein neuer Mitarbeiter dazugekommen ist, muss ich den manuell hinzufügen.

AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen
23.03.2016 10:32:06
UweD
Hallo
was hälst du hiervon?

'Code muss in Mappe1
Sub copy()
Dim WB2 As Workbook, TB1, TB2, LR1&, LR2&, i&, c
Set TB1 = ActiveWorkbook.Sheets(1)
LR1 = TB1.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der SpalteA
Set WB2 = Workbooks.Open(Filename:="C:\Users\Verein\Desktop\test2.xlsm") 'Kein Readonly
Set TB2 = WB2.Sheets(1)
For i = 2 To LR1
Set c = TB2.Range("A:A").Find(TB1.Cells(i, 1).Value, LookIn:=xlValues)
If Not c Is Nothing Then
TB2.Cells(c.Row, 2) = TB1.Cells(i, 2)
TB2.Cells(c.Row, 6) = TB1.Cells(i, 3)
Else
LR2 = TB2.Cells(Rows.Count, 1).End(xlUp).Row + 1
TB2.Cells(LR2, 1) = TB1.Cells(i, 1)
TB2.Cells(LR2, 2) = TB1.Cells(i, 2)
TB2.Cells(LR2, 6) = TB1.Cells(i, 3)
End If
Next
WB2.Close savechanges:=True
End Sub
Gruß UweD

Anzeige
AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen
23.03.2016 11:42:25
Markus
Hey, vielen Dank schon mal für deine Hilfe!
Das wäre das was ich suche, aber er erstellt mir, wenn die Mitarbeiternummer aus Spalte A im Zieldokument noch nicht vorhanden ist, keine neue Zeile mit den Werten, sondern er mach dann einfach Garnichts.

AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen
23.03.2016 11:58:09
UweD
kann ich nicht nachvollziehen.
hierdurch wird das realisiert.

Else
LR2 = TB2.Cells(Rows.Count, 1).End(xlUp).Row + 1
TB2.Cells(LR2, 1) = TB1.Cells(i, 1)
TB2.Cells(LR2, 2) = TB1.Cells(i, 2)
TB2.Cells(LR2, 6) = TB1.Cells(i, 3)
End If

Dann stell doch mal deine Dateien (abgespeckt) online
Ich lasse offen
Gruß UweD
In meinen Musterdateien klappt das perfekt

Anzeige
AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen
23.03.2016 13:18:28
UweD
Du hast in der Zieltabelle ab Zeile 32769 noch Werte stehen und da ist 4747 bei
Wenn du die weglöschst, dann klappt es
Gruß UweD

AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen
23.03.2016 13:36:18
Markus
ah, wie die Werte da bloß hingekommen sind. Danke! So funktioniert der Code.
Eine Frage hätte ich noch. Wie muss ich denn den Code abändern, damit er mir nicht nach der letzten Zeile eine neue Zeile einfügt sondern vor der letzten? Weil in die letzte wollte ich eine Summenformel packen, die dann immer da bleiben sollte.

Anzeige
AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen
23.03.2016 14:01:24
UweD
Hi
Ich würde zwischen Daten und Summenzeile eine Leerzeile lassen.
Also z.B.
- Werte stehen bis Zeile 40
- Leerzeile 41
- Diese leerzeile mit in die Summenformel reinnehmen : in X42=Summe(X2:X41)
Wenn jetzt vor 41 eine Zeile eingefügt wird, muss die Formel nicht abgeändert werden;
die ändert sich automatisch auf =Summe(X2:X42)
Dann wäre das so möglich...

Else
LR2 = TB2.Cells(Rows.Count, 1).End(xlUp).Row - 1
TB2.Rows(LR2).Insert Shift:=xlDown
TB2.Cells(LR2, 1) = TB1.Cells(i, 1)
TB2.Cells(LR2, 2) = TB1.Cells(i, 2)
TB2.Cells(LR2, 6) = TB1.Cells(i, 3)
End If
Gruß UweD

Anzeige
AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen
23.03.2016 14:37:49
Markus
ok das werde ich so machen. Danke UweD!

AW: Zwei Arbeitsmappen nach Mitgliedsnummer abgleichen
23.03.2016 14:37:55
Markus
ok das werde ich so machen. Danke UweD!

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige