Hallo Liebe Leute,
Ich habe die Aufgabe bekommen eine Vollautomatisch füllende Tabelle zu generieren, kurze Erklärung:
- Ordner durchsuchen, mit über 100 XLS Dateien
- Bestimmtes Arbeitsblatt, Bestimmte Zellen auswählen und kopieren
- In neue Arbeitsmappe einfügen und doppelte Zeilen löschen
JEtzt die Frage, kann man das so programmieren das die Doppelten werte erst gar nicht eingeschrieben werden oder muss ich das weil es sich ja dann um eine neue Zeile handelt im neuen Arbeitsblatt immer hinterher machen?
hab das soweit auch programmiert und es funktioniert bis auf das löschen auch schon, nur check ichs jetzt nicht mehr ....
hier mal mein code dafür, danke für eure Hilfe
Muss hier aber zugeben das ich diesen nicht zu 100% verstehe sonst würde ich hier gleich die Abfrage mit den Doppelten werten einfügen, momentan hab ich mich hieran versucht, allerdings löscht er so gar nichts mehr.
Dim sPfad As String
Dim sDatei As String
Dim sBlatt As String
Dim aZellAdresse() As Variant, iZA As Long
Dim aErgebnis() As Variant, iE As Long
sBlatt = "Blatt1" ' ArbeitsbattName Quelldatei
aZellAdresse() = Array("A5", "B5", "C5", "D5", "E5", "F5") ' Folgende Zellen werden kopiert
'Schritt 1: Schleife über alle Excel Dateien in einem Verzeichnis
sPfad = "C:\Documents\VBA\Test\"
sDatei = Dir(CStr(sPfad & "*.xls")) 'Alle Excel Dateien
Do While sDatei <> ""
iE = iE + 1
ReDim Preserve aErgebnis(1 To UBound(aZellAdresse) + 2, 1 To iE)
aErgebnis(1, iE) = sDatei
For iZA = LBound(aZellAdresse) To UBound(aZellAdresse)
aErgebnis(iZA + 1, iE) = "='" & sPfad & "[" & sDatei & "]" & sBlatt & "'!" & aZellAdresse(iZA)
Next
'Nächste Datei
sDatei = Dir()
Loop
If iE > 0 Then
Application.ScreenUpdating = False 'Das "Flackern" ausstellen
'Schritt 2: Neues Arbeitsblatt für die Ergebnisse erstellen und letzte freie Zeile suchen
With ThisWorkbook.Worksheets("Tabelle1")
With .Range("A65536").End(xlUp).Offset(1, 0).Resize(UBound(aErgebnis, 2), UBound(aErgebnis, 1))
.Formula = WorksheetFunction.Transpose(aErgebnis)
.Formula = .Value
End With
End With
Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
Columns("A:A").NumberFormat = "m/d/yyyy hh:mm"
End If
~f~
~f~
Dim iRow As Integer, iRowL As Integer
iRowL = Cells(Cells.Rows.Count, 1).End(xlUp).Row
For iRow = iRowL To 1 Step -1
If WorksheetFunction.CountIf(Range"1:1"), Cells(iRow, 1)) > 1 Then
Rows(iRow).Delete
End If
Next iRow