Live-Forum - Die aktuellen Beiträge
Datum
Titel
27.04.2024 16:48:06
Formel gibt Falsch aus und ich weiß nicht warum - VBA
27.04.2024 14:45:54
Verknüpfung Tabelleneinträge mit Datumsspalte
27.04.2024 12:08:58
Mittelwertwenn - ich kapiere es nicht :-(
26.04.2024 21:51:33
Idee für Grafik
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1916to1920
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1916to1920
1916to1920
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Importieren von Daten

Importieren von Daten
06.02.2023 12:54:35
Daten
Hallo
Ich habe den unten genannten Code in Verwendung.
Ich würde diesen gerne so erweitern, das ich in Tabelle1, Zelle L1, M1, N1 mehrere Namen/Bezeichnungen eintragen und der Code mir aus der geschlossenen
Excel Datei, diese Tabellen in meine Tabelle1 importiert.
D.h in den Zellen die Tabellenblätter schreibe, die ich importieren will.
Geht das bzw. wie würde der geändert werden?
Sub Mehrere_Dateien_auswaehlen()
 
 
Dim arrDateien As Variant
Dim WBQuelle As Workbook
Dim LetzteZeile As Long
Dim cntDatei As Long
Dim rngQuelle As Range
 
'Screenupdating und PopUps deaktivieren
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
'Benutzer Dateien ausw_hlen lassen
arrDateien = Application.GetOpenFilename(FileFilter:="Excel-Dateien (*.xls*),*.xls*", MultiSelect:=True)
 
'Wurde eine Datei ausgew_hlt?
If IsArray(arrDateien) Then
 
    'Schleife Ùber alle ausgew_hlten Dateien
    For cntDatei = 1 To UBound(arrDateien)
     
        LetzteZeile = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
         
        'Aktuelle Arbeitsmappe _ffnen
        Set WBQuelle = Workbooks.Open(Filename:=arrDateien(cntDatei))
         
        'Daten-Range setzen
        Set rngQuelle = WBQuelle.Worksheets(1).Range("B2").CurrentRegion
         
        'Daten kopieren und einfÙgen
        Intersect(rngQuelle, rngQuelle.Offset(1, 0)).Copy
        ThisWorkbook.Worksheets(1).Range("A" & LetzteZeile + 1).PasteSpecial
         
        'Arbeitsmappe schlie¤en
        WBQuelle.Close SaveChanges:=False
    Next cntDatei
 
End If
 
'Screenupdating und PopUps aktivieren
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Worksheets("Auswertung").Select
ActiveSheet.PivotTables("PivotTable5").PivotCache.Refresh
'Bereitgestellt von VBATrainer: www.vbatrainer.de
End Sub

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Importieren von Daten
06.02.2023 13:09:09
Daten
Hallo,
teste mal:
Sub Mehrere_Dateien_auswaehlen()
 
 
Dim arrDateien As Variant
Dim WBQuelle As Workbook
Dim LetzteZeile As Long
Dim cntDatei As Long
Dim rngQuelle As Range
Dim vntFiles, vFile
 
'Screenupdating und PopUps deaktivieren
Application.ScreenUpdating = False
Application.DisplayAlerts = False
vntFiles = Application.Transpose(Application.Transpose(Tabelle1.Range("L1:N1")))
'Benutzer Dateien ausw_hlen lassen
arrDateien = Application.GetOpenFilename(FileFilter:="Excel-Dateien (*.xls*),*.xls*", MultiSelect:=True)
 
'Wurde eine Datei ausgew_hlt?
If IsArray(arrDateien) Then
 
    'Schleife Ùber alle ausgew_hlten Dateien
    For cntDatei = 1 To UBound(arrDateien)
     
        LetzteZeile = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
         
        'Aktuelle Arbeitsmappe _ffnen
        Set WBQuelle = Workbooks.Open(Filename:=arrDateien(cntDatei))
        For Each vFile In vntFiles
          'Daten-Range setzen
          Set rngQuelle = WBQuelle.Worksheets(vFile).Range("B2").CurrentRegion
          'Daten kopieren und einfÙgen
          Intersect(rngQuelle, rngQuelle.Offset(1, 0)).Copy
          ThisWorkbook.Worksheets(1).Range("A" & LetzteZeile + 1).PasteSpecial
        Next vFile
        'Arbeitsmappe schlie¤en
        WBQuelle.Close SaveChanges:=False
    Next cntDatei
 
End If
 
'Screenupdating und PopUps aktivieren
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Worksheets("Auswertung").Select
ActiveSheet.PivotTables("PivotTable5").PivotCache.Refresh
'Bereitgestellt von VBATrainer: www.vbatrainer.de
End Sub
Gruß
Rudi
Anzeige
AW: Importieren von Daten
06.02.2023 15:06:33
Daten
Hallo
Danke für die Schnelle Antwort.
Der Code bleibt bei
Set rngQuelle = WBQuelle.Worksheets(vFile).Range("A1").CurrentRegion
hängen, hat aber die Daten in die Datei kopiert und die Quelldatei bleibt offen.
Liegt es daran, das ich nur ein Tabellenblatt importieren wollte?
Also, wenn ich nur ein Tabellenblatt auswählen kann würde es mir schon reichen.
Richtig toll wäre, wenn ich per UserForm vielleicht die Datei öffne und dort die Tabellenblätter auswählen könnte.
Sicherlich schwierig und aufwändiger oder?
Gruß
Thomas
AW: Importieren von Daten
06.02.2023 15:30:57
Daten
Voraussetzung ist, dass es in der Quelldatei die Sheets aus L1:M1 gibt.
Fehler abgefangen:
Sub Mehrere_Dateien_auswaehlen()
 
Dim arrDateien As Variant
Dim WBQuelle As Workbook
Dim wsQ As Worksheet
Dim LetzteZeile As Long
Dim cntDatei As Long
Dim rngQuelle As Range
Dim vntFiles, vFile
 
'Screenupdating und PopUps deaktivieren
Application.ScreenUpdating = False
Application.DisplayAlerts = False
vntFiles = Application.Transpose(Application.Transpose(Tabelle1.Range("L1:N1")))
'Benutzer Dateien ausw_hlen lassen
arrDateien = Application.GetOpenFilename(FileFilter:="Excel-Dateien (*.xls*),*.xls*", MultiSelect:=True)
 
'Wurde eine Datei ausgew_hlt?
If IsArray(arrDateien) Then
 
    'Schleife Ùber alle ausgew_hlten Dateien
    For cntDatei = 1 To UBound(arrDateien)
     
        LetzteZeile = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
         
        'Aktuelle Arbeitsmappe _ffnen
        Set WBQuelle = Workbooks.Open(Filename:=arrDateien(cntDatei))
        For Each vFile In vntFiles
          Set wsQ = Nothing
          
          On Error Resume Next
          Set wsQ = WBQuelle.Worksheets(vFile)
          On Error GoTo 0
          
          If Not wsQ Is Nothing Then
            'Daten-Range setzen
            Set rngQuelle = wsQ.Range("B2").CurrentRegion
            'Daten kopieren und einfÙgen
            Intersect(rngQuelle, rngQuelle.Offset(1, 0)).Copy
            ThisWorkbook.Worksheets(1).Range("A" & LetzteZeile + 1).PasteSpecial
          End If
        Next vFile
        
        'Arbeitsmappe schlie¤en
        WBQuelle.Close SaveChanges:=False
    Next cntDatei
 
End If
 
'Screenupdating und PopUps aktivieren
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Worksheets("Auswertung").Select
ActiveSheet.PivotTables("PivotTable5").PivotCache.Refresh
'Bereitgestellt von VBATrainer: www.vbatrainer.de
End Sub
Gruß
Rudi
Anzeige
AW: Importieren von Daten
06.02.2023 17:06:45
Daten
Ich habe folgendes gemacht.
Ich habe eine Testdatei erstellt mit drei Tabellen. Test1, Test2 und Test3.
Mappe "Test1" die Werte 101 bis 130 in die Zeile B1 bis B30
Mappe "Test2" die Werte 201 bis 230 in die Zeile B1 bis B30
Mappe "Test3" die Werte 301 bis 330 in die Zeile B1 bis B30 geschrieben.
Wenn ich den den VBA Code starte, läuft er ohne Probleme durch.
Aber es sind nur die Werte von Tabelle "Test3" da, vermutlich überschreibt es sie immer wieder...
Hatte erwartet, das 101-130, dann 201-230 und 301-330 untereinander stehen.
Gruß
Thomas
AW: Importieren von Daten
06.02.2023 19:32:21
Daten
Hallo Thomas
wie ich das sehe fehlt schlicht und einfach der Wert der Varible "LetzteZeile". (Vergessen?)
LetzteZeile = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Intersect(rngQuelle, rngQuelle.Offset(1, 0)).Copy
ThisWorkbook.Worksheets(1).Cells("A" & LetzteZeile + 1).PasteSpecial
mfg Piet
Anzeige

Links zu Excel-Dialogen

UserForm

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige