Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1664to1668
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

Import bestimmter Zeilen aus verschiedenen Dateien

Import bestimmter Zeilen aus verschiedenen Dateien
08.01.2019 13:29:29
Michael
Hallo zusammen,
ich habe bereits die Suchfunktion hier verwendet aber keine entsprechende Lösung gefunden.
Ich habe folgendes Problem, bei dem ich leider nicht weiterkomme:
Ich möchte eine Excel-Zusammenfassungsdatei (ZD) haben, die sich per Makro aus verschiedenen Excel-Dateien bestimmte Werte kopiert und alle in einem Tabellenblatt untereinander innerhalb der ZD wiederspiegelt.
Die Sache ist jedoch die, dass aus den verschiedenen Excel-Dateien immer nur bestimmte Zellen kopiert werden sollen. Der zu kopierende Zeilenbereich hat allerdings nicht immer dieselbe Größe. Zur Verdeutlichung habe ich mal eine Beispieldatei angehangen und den zu kopierenden Bereich gelb markiert. Es soll bei den zu ausgewählten Dateien immer ab dem ersten Datum angefangen werden zu kopieren und mit den letzten Kosten enden (ohne Gesamtergebnis).
Geplant habe ich den Importvorgang wie folgt:
1. Beim Ausführen des Makro öffnet sich eine Dateiauswahl mit einem hinterlegten Startordner
2. Gewünschte Dateien auswählen
3. Automatisiertes Importieren bzw. kopieren der jeweiligen Zellen aus den ausgewählten Dateien in ZD
Ich hoffe, dass mir auf diesem Wege jemand weiterhelfen kann.. Meine bisherigen Versuche haben bis jetzt leider keinen Erfolg gebracht.
Wahrscheinlich muss der Dateityp wieder auf -.xlsx geändert werden um sie ordentlich zu verwenden. Anders war jedoch kein Upload möglich.
Beispieldatei: https://www.herber.de/bbs/user/126573.xlsx
MfG
Michael

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Nachfragen
08.01.2019 13:46:23
Fennek
Hallo,
um per Makro auf die Liste zugreifen zu können, wären einige weitere Angaben hilfreich:
- stehen die Daten immer und ausschließich in Sheets(1)
- ist der Bereich immer durch Leerzeilen und -spalten abgegrenzt
- ist es eine "intelligete Tabelle" (table)
Der VBA-Code ist relativ einfach und wurde -auch hier im Forum- sschon oft gezeigt. Für DHL werde ich ihn aber nicht wiederholen.
mfg
AW: Import bestimmter Zeilen aus verschiedenen Dateien
08.01.2019 14:25:52
UweD
Hallo
so?
Modul1
Option Explicit 
 
Sub Makro5() 
    Dim Pfad As String, Datei As String, WB1, TB1, WB2, TB2, WF 
    Dim Zvon As Integer, Zbis As Double, LR As Double 
    Dim Dlg As FileDialog 
    Set WF = WorksheetFunction 
     
    '##### Vorgaben >>>> anpassen 
    Set WB1 = ActiveWorkbook ' Zieldatei 
    Set TB1 = WB1.Sheets("Tabelle1") 
    Pfad = "X:\Temp\Test\" 'mit \ am Ende 
    '########################### 
     
     
    '######## Datei wählen 
    Set Dlg = Application.FileDialog(msoFileDialogFilePicker) 
    With Dlg 
        .Filters.Add "Exceldateien", "*.xls*" 'Filter, welche Dateien darf er auswählen 
        .InitialFileName = Pfad 'Welches Verzeichnis soll voreingestellt sein 
    End With 
     
    If Dlg.Show Then 
        Datei = Dlg.SelectedItems(1) 
    Else 
        MsgBox "Die Aktion wurde abgebrochen", vbCritical, "Abbruch...!" 
        Exit Sub 
    End If 
    '########################### 
         
    '########Datei öffnen 
    Set WB2 = Workbooks.Open(Datei) 
    Set TB2 = WB2.Sheets(1) 
    '########################### 
     
     
    '########Zeilen finden 
    If WF.CountIf(TB2.Columns(1), "Datum") = 0 Or WF.CountIf(TB2.Columns(1), "Gesamtergebnis") = 0 Then 
        MsgBox "Datenfehler" 
        Exit Sub 
    End If 
    Zvon = WF.Match("Datum", TB2.Columns(1)) + 1 
    Zbis = WF.Match("Gesamtergebnis", TB2.Columns(1)) - 1 
    '########################### 
     
    '######## 'erste Freie Zielzeile 
    LR = TB1.Cells(TB1.Rows.Count, 1).End(xlUp).Row + 1 
 
    '######## 'Bereich unten anfügen 
    TB1.Cells(LR, 1).Resize(Zbis - Zvon + 1, 6).Value = TB2.Cells(Zvon, 1).Resize(Zbis - Zvon + 1, 6).Value 
     
    '######## 'Datei wieder schließen 
    WB2.Close False 
     
End Sub 

LG UweD
Anzeige
AW: Import bestimmter Zeilen aus verschiedenen Dateien
08.01.2019 14:47:48
Michael
Hallo UweD,
vielen, vielen Dank!!
Der Code läuft soweit einwandfrei und er kopiert die ensprechenden Zeilen aus der ausgewählten Datei.
Wenn ich jedoch zwei, - oder mehr Dateien auswähle, kopiert er immer nur die Zeilen aus der ersten Datei?
Muss ich hier nachträglich eventuell noch etwas anpassen?
@Fennek: Trotzdem vielen Dank für die zeitnahe Rückmeldung und deine Bemühungen!
Gruß
AW: Import bestimmter Zeilen aus verschiedenen Dateien
08.01.2019 15:09:15
UweD
Hallo nochmal
dann so
Option Explicit
 
Sub Kopieren()
    Dim Pfad As String, WB1, TB1, WB2, TB2, WF
    Dim Zvon As Integer, Zbis As Double, LR As Double
    Dim DLG As FileDialog, SI
    Set WF = WorksheetFunction
     
    '##### Vorgaben >>>> anpassen 
    Set WB1 = ActiveWorkbook ' Zieldatei 
    Set TB1 = WB1.Sheets("Tabelle1")
    Pfad = "X:\Temp\Test\" 'mit \ am Ende 
    '########################### 
     
    '####Flackern verhindern 
    Application.ScreenUpdating = False
    
     
    '######## Dateien wählen 
    Set DLG = Application.FileDialog(msoFileDialogFilePicker)
    With DLG
        .AllowMultiSelect = True 'Darf der User mehrere Dateien auswählen Ja 
        .Filters.Add "Exceldateien", "*.xls*" 'Filter, welche Dateien darf er auswählen 
        .InitialFileName = Pfad 'Welches Verzeichnis soll voreingestellt sein 
    End With
     
    If DLG.Show Then
        For Each SI In DLG.SelectedItems
            '########Datei öffnen 
            Set WB2 = Workbooks.Open(SI)
            Set TB2 = WB2.Sheets(1)
            '########################### 
                
                
            '########Zeilen finden 
            If WF.CountIf(TB2.Columns(1), "Datum") = 0 Or WF.CountIf(TB2.Columns(1), "Gesamtergebnis") = 0 Then
                MsgBox "Fehler in Datei:     ''" & SI & "''", vbCritical, "Abbruch...!"
                Exit Sub
            End If
            Zvon = WF.Match("Datum", TB2.Columns(1)) + 1
            Zbis = WF.Match("Gesamtergebnis", TB2.Columns(1)) - 1
            '########################### 
                
            '######## 'erste Freie Zielzeile 
            LR = TB1.Cells(TB1.Rows.Count, 1).End(xlUp).Row + 1
            
            '######## 'Bereich unten anfügen 
            TB1.Cells(LR, 1).Resize(Zbis - Zvon + 1, 6).Value = TB2.Cells(Zvon, 1).Resize(Zbis - Zvon + 1, 6).Value
                
            '######## 'Datei wieder schließen 
            WB2.Close False
        Next
        
    Else
        MsgBox "Die Aktion wurde abgebrochen", vbCritical, "Abbruch...!"
        Exit Sub
    End If
         
     
End Sub

LG UweD
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige