Hallo Ahibi,
das folgende Makro gehört in Standardmodul der Arbeitsmappe, in der die Daten ergänzt werde sollen:
Sub Import()
Dim arrDaten As Variant
Dim lngZeile As Long
Dim lngLetzte As Long
Dim Datei
Dim d As Long
Dim b As Long
Dim bExists As Boolean
Dim arrVorhanden As Variant
'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
'Daten aus erstem Blatt in Array einlesn
With .Worksheets(1)
arrDaten = .Range(.Cells(1, 1), .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 8))
End With
'Arbeitsmappe ohne Änderungen schließen
.Close (False)
End With
With ThisWorkbook.Worksheets("Pumpen")
'Daten aus Spalte B in Array einlesen
arrVorhanden = .Range(.Cells(6, 2), .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 2))
'nun vorhandene Zeilen durchlaufen
For d = 1 To UBound(arrDaten, 1)
For b = 1 To UBound(arrVorhanden, 1)
'Marker für vorhanden auf Falsch setzen
bExists = False
If arrVorhanden(b, 1) = arrDaten(d, 1) Then
bExists = True 'Marker für vorhanden
Exit For 'Schleife verlassen
End If
Next b
'nun ggf. nicht vorhandene Daten ergänzen
If bExists = False Then
lngEinf = .Cells(Rows.Count, 2).End(xlUp).Row + 1 'Einfügezeile wird ermittelt
'Daten werden in Blatt geschrieben
With .Cells(lngEinf, 2)
.NumberFormat = "@" 'Zelle als Text formatieren, damit Nummer mit Punkt übernommen wird
.Value = arrDaten(d, 1) 'Inhalt einfügen
End With
.Cells(lngEinf, 3) = arrDaten(d, 2)
.Cells(lngEinf, 4) = arrDaten(d, 3)
.Cells(lngEinf, 5) = arrDaten(d, 4)
.Cells(lngEinf, 6) = arrDaten(d, 5)
.Cells(lngEinf, 7) = arrDaten(d, 6)
.Cells(lngEinf, 11) = arrDaten(d, 7)
.Cells(lngEinf, 13) = arrDaten(d, 8)
End If
Next d
End With
'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True
End Sub
Teste mal, ob das Makro so funktioniert, wie du dir das vorstellst.
Und viel Spaß beim VBA-Lernen .
Gruß
M.O.