Hallo Andreas,
das folgende Makro gehört in ein Standardmodul deiner Master-Arbeitsmappe:
Sub vergleichen()
Dim Datei As Variant
Dim strDateiname As String
Dim i As Long
Dim lngLZeile1 As Long
Dim lngLSpalte1 As Long
Dim lngLZeile2 As Long
Dim lngLSpalte2 As Long
Dim arrDaten As Variant
Dim arrZusatzdaten As Variant
Dim arrMDaten As Variant
Dim arrMZusatzdaten As Variant
Dim z As Long
Dim s As Long
Dim Antwort
'Datei-Öffnen Dialog aufrufen
Datei = Application.GetOpenFilename(FileFilter:="Microsoft Excel-Dateien (*.xl*), *.xl*", Title:="EINE Datei zum Öffnen auswählen")
If Datei = False Then
'Makro abbrechen wenn Benutzer den Öffnen-Dialog abbricht
MsgBox "Der Benutzer hat abgebrochen.", vbInformation
Exit Sub
End If
'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False
'ausgewählte Datei öffnen
Workbooks.Open (Datei)
With ActiveWorkbook
For i = 1 To .Worksheets.Count
'Arbeitsblatt Daten suchen
If .Worksheets(i).Name = "Daten" Then
'Daten aus Arbeitsblatt in Array einlesen
With Worksheets(i)
lngLZeile1 = .Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile ermitteln
lngLSpalte1 = .Cells(2, Columns.Count).End(xlToLeft).Column 'letzte Spalte ermitteln
'Prüfen, ob letzte Zeile und Spalte mit Masterdatei identisch sind, ansonsten ggf. anpassen
If lngLZeile1 < ThisWorkbook.Worksheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row Then lngZeile1 = ThisWorkbook.wokrsheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row
If lngLSpalte1 < ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).End(xlToLeft).Column Then lngSpalte1 = ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).End(xlToLeft).Column
ReDim arrDaten(lngLZeile1, lngLSpalte1) 'Array redimensionieren
arrDaten = .Range(.Cells(1, 1), .Cells(lngLZeile1, lngLSpalte1)) 'Daten ins Array einlesen
End With
End If
'Arbeitsblatt Zusatzdaten suchen
If .Worksheets(i).Name = "Zusatzdaten" Then
With Worksheets(i)
lngLZeile2 = .Cells(Rows.Count, 1).End(xlUp).Row
lngLSpalte2 = .Cells(2, Columns.Count).End(xlToLeft).Column
If lngLZeile2 < ThisWorkbook.Worksheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row Then lngZeile2 = ThisWorkbook.wokrsheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row
If lngSpalte2 < ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).End(xlToLeft).Column Then lngSpalte2 = ThisWorkbook.Worksheets("Daten").Cells(2, Columns.Count).Column
ReDim arrZusatzdaten(lngLZeile2, lngLSpalte2)
arrZusatzdaten = .Range(.Cells(1, 1), .Cells(lngLZeile2, lngLSpalte2))
End With
End If
Next i
'Prüfen, ob Tabellenblätter gefunden wurden und ggf. Fehlermeldung ausgeben und Makro abbrechen
If IsEmpty(arrDaten) And IsEmpty(arrZusatzdaten) Then
MsgBox "Achtung! Die Arbeitsblätter ""Daten"" und ""Zusatzdaten"" wurden in der Datei " & .Name & " nicht gefunden!", 16, "Abbruch wegen Fehler"
Exit Sub
End If
If IsEmpty(arrDaten) Then
MsgBox "Achtung! Das Arbeitsblatt ""Daten"" wurde in der Datei " & .Name & " nicht gefunden!", 16, "Abbruch wegen Fehler"
Exit Sub
End If
If IsEmpty(arrZusatzdaten) Then
MsgBox "Achtung! Das Arbeitsblatt ""Zusatzdaten"" wurde in der Datei " & .Name & " nicht gefunden!", 16, "Abbruch wegen Fehler"
Exit Sub
End If
'Name der geöffnenten Datei in Variable schreiben
strDateiname = .Name
'geöffnete Datei wieder schließen, ohne zu speichern
.Close (False)
End With
'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True
'Inhalte der Arbeitsblätter Daten vergleichen
'Zuerst Daten in Array einlesen
With ThisWorkbook.Worksheets("Daten")
.Activate 'auf Arbeitsblatt wechseln
ReDim arrMDaten(lngLZeile1, lngLSpalte1)
arrMDaten = .Range(.Cells(1, 1), .Cells(lngLZeile1, lngLSpalte1))
'nun Daten vergleichen
For z = 1 To UBound(arrMDaten, 1)
For s = 1 To UBound(arrMDaten, 2)
'Falls unterschiedliche Daten vorhanden, nachfragen, ob Daten aktualisiert werden sollen
If arrMDaten(z, s) <> arrDaten(z, s) Then
'betreffende Zelle auswählen
.Cells(z, s).Select
Antwort = MsgBox("Zelle " & Cells(z, s).Address & vbLf & "Daten in Master: " & arrMDaten(z, s) & vbLf & "Daten in " & strDateiname & ": " & arrDaten(z, s), 36, "Daten in Masterdatei aktualiseren?")
'Falls OK gedrückt wird, Daten in Masterdatei überschreiben
If Antwort = vbYes Then .Cells(z, s) = arrDaten(z, s)
End If
Next s
Next z
End With
'Inhalte der Arbeitsblätter Daten vergleichen
'Zuerst Zusatzdaten in Array einlesen
With ThisWorkbook.Worksheets("Zusatzdaten")
.Activate 'auf Arbeitsblatt wechseln
ReDim arrMZusatzdaten(lngLZeile2, lngLSpalte2)
arrMZusatzdaten = .Range(.Cells(1, 1), .Cells(lngLZeile2, lngLSpalte2))
'nun Daten vergleichen
For z = 1 To UBound(arrMZusatzdaten, 1)
For s = 1 To UBound(arrMZusatzdaten, 2)
'Falls unterschiedliche Daten vorhanden, nachfragen, ob Daten aktualisiert werden sollen
If arrMZusatzdaten(z, s) <> arrZusatzdaten(z, s) Then
.Cells(z, s).Select
Antwort = MsgBox("Zelle " & Cells(z, s).Address & vbLf & "Daten in Master: " & arrMZusatzdaten(z, s) & vbLf & "Daten in " & strDateiname & ": " & arrZusatzdaten(z, s), 36, "Daten in Masterdatei aktualiseren?")
If Antwort = vbYes Then .Cells(z, s) = arrZusatzdaten(z, s)
End If
Next s
Next z
End With
'Abschlussmeldung
MsgBox "Vergleich abgeschlossen!", 48, "Info"
End Sub
Teste es erst einmal in einer Testversion deiner Mastermappe und schau mal, ob alles richtig funktioniert.
In der Master-Arbeitsmappe wird nicht geprüft, ob die Tabellenblätter "Daten" und "Zusatzdaten" vorhanden sind.
Gruß
M.O.