Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.05.2024 23:36:08
IFNA Funktion in WENNNV übertragen
16.05.2024 19:31:55
Zellenfarbe beim.Filtern ändern
16.05.2024 19:29:08
Mit INDIREKT() auf andere Tabellenblätter referenzieren
16.05.2024 19:06:22
Monatssumme / Zahlweise / Kalenderjahr
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1960to1964
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
1960to1964
1960to1964
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA mehrere Dateien öffnen und Bereich kopieren

VBA mehrere Dateien öffnen und Bereich kopieren
23.01.2024 10:32:42
R
Hallo,
ich möchte über VBA aus mehrere Exceldatein in einem Ordner, jeweils in einem Arbeitsblatt (der Name ist immer gleich) einen Bestimmten Bereich rauskopieren (O5:O14) und das in ein leeres Excelblatt nacheinander einfügen.

Meine Kenntnisse in VBA sind leider nicht so gut. Die Auswahl des Ordners und das er alle darin enthaltenen Dateien nimmt, bekomme ich noch hin. Aber das bestimmte Blatt (mit unter sind mehrere Arbeitsblätter in einer Datei drin) mit den Bereich auszuwählen und den dann zu kopieren und beim einfügen für die Spalten hochzuzählen klappt gar nicht.

Kann mir bitte jemand helfen und den Code dafür geben?
AW: es wäre schon günstig (D)eine Datei hier hochzuladen oT
23.01.2024 10:42:56
JoWE
AW: VBA mehrere Dateien öffnen und Bereich kopieren
23.01.2024 11:20:50
UweD
Hallo

sollen es aus einem Verzeichnis nur ein paar sein, oder Alle?

LG UweD
AW: VBA mehrere Dateien öffnen und Bereich kopieren
23.01.2024 13:18:08
R
Hallo UweD: hatte den Code jetzt erst gelesen, Danke!

Das funktioniert soweit. Ich hatte es allerdings etwas schwer beschrieben..... das einfücgen sollte nicht untereinander erfolgen, sondern die Bereiche nebeneinander.
Sprich Einfügen der erste Bereich (die erste Datei) in Spalte A, der zweite in B ... usw.

Was müsste ich hier dann ändern

'Bereich kopieren
Sheets(TBx).Range(RNG).Copy TBN.Cells(LR + 1, Spz)
AW: VBA mehrere Dateien öffnen und Bereich kopieren
23.01.2024 13:31:31
UweD
Hallo

Dann so 

Sub alle_Dateien_Verzeichnis2() '

    On Error GoTo Fehler

    Dim Pfad As String, Ext As String, Datei As String

    Dim Spz As Integer, LC As Long

    Dim WB As Workbook, TBN As Worksheet, TBx As String, RNG As String

    

    Ext = "*.xls*"

    Pfad = "D:\excel\Temp\Test\" '**** mit \

    

    Spz = 1 'Zielspalte A

    

    TBx = "AA" 'Quellblatt

    RNG = "O5:O14"

    

    'Neues Zielblatt

    Set TBN = ThisWorkbook.Sheets.Add(after:=Sheets(Sheets.Count))



    'Alle Dateien durchlaufen

    Datei = Dir(Pfad & Ext)

    Do While Len(Datei) > 0

    

        Set WB = Workbooks.Open(Filename:=Pfad & Datei)

        

        

        LC = TBN.Cells.SpecialCells(xlCellTypeLastCell).Column 'Letzte Spalte des gesamten Blattes

    

        'Bereich kopieren

        Sheets(TBx).Range(RNG).Copy TBN.Cells(1, LC + 1)

        

        Workbooks(Datei).Close False

        

        Datei = Dir() ' nächste Datei

    Loop

    

    

    Err.Clear

Fehler:

    If Err.Number > 0 Then MsgBox "Fehler: " & _

        Err.Number & vbLf & Err.Description: Err.Clear



End Sub


LG UweD
Anzeige
AW: VBA mehrere Dateien öffnen und Bereich kopieren
23.01.2024 14:12:12
UweD
Hi

wenn es nur einige Dateien sein sollen.. 

Sub alle_Dateien_Verzeichnis2() '

    On Error GoTo Fehler

    Dim Pfad As String, Arr(), i As Integer, LC As Long

    Dim WB As Workbook, TBN As Worksheet, TBx As String, RNG As String

    

    'Die zu betrachtenden Dateien

    Arr = Array("222.xlsm", "333.xlsm")

    

    Pfad = "D:\excel\Temp\Test\" '**** mit \

    

    TBx = "AA" 'Quellblatt

    RNG = "O5:O14"

    

    'Neues Zielblatt

    With ThisWorkbook

        Set TBN = .Sheets.Add(after:=.Sheets(.Sheets.Count))

    End With

    

    For i = LBound(Arr) To UBound(Arr)

        If Dir(Pfad & Arr(i)) > "" Then

            Set WB = Workbooks.Open(Filename:=Pfad & Arr(i))

        Else

            MsgBox Pfad & Arr(i) & "  fehlt"

        End If

        

        LC = TBN.Cells.SpecialCells(xlCellTypeLastCell).Column 'Letzte Spalte des gesamten Blattes

    

        'Bereich kopieren

        Sheets(TBx).Range(RNG).Copy TBN.Cells(1, LC + 1)

        

        Workbooks(Arr(i)).Close False

        

    Next

    

    Err.Clear

Fehler:

    If Err.Number > 0 Then MsgBox "Fehler: " & _

        Err.Number & vbLf & Err.Description: Err.Clear



End Sub

LG UweD
Anzeige
AW: VBA mehrere Dateien öffnen und Bereich kopieren
23.01.2024 14:50:08
R
@UweD:

ich muss mir das später mal anschauen. Das zweite ist ausreichend.
Es kommt derzeit bei mir nur "Fehler 9 => Index außerhalb des gültigen Bereichs"
ich weis nur noch nicht warum. Vor allem weil ich den ersten Code von Dir nochmal getestet habe und jetzt den gleichen Fehler bekomme.

Komme gerade nicht dahinter....
AW: VBA mehrere Dateien öffnen und Bereich kopieren
23.01.2024 15:07:35
UweD
Hallo

Meist ist der Blattname NICHT vorhanden

LG UweD
AW: VBA mehrere Dateien öffnen und Bereich kopieren
24.01.2024 09:56:19
R
@UweD:

nur kurzes Update das ich noch dran bin...
das mit dem Namen habe ich auch vermutet. Es scheint auch der Grund zu sein.
Allerdings funktioniert jetzt auch das kopieren nicht mehr, auch nicht von dem ersten Code. Und ich sehe einfach nicht warum.

folgendes habe ich noch gemacht. das Blatt von der Quelldatei wird/ist umbenannt. Den Name des Blattes kann ich hier im Code nicht eintragen da kommt der Fehler. (ging Gestern aber eigentlich?) Ich habe auch schonmal gelesen das Excel auf seinen ursprünglichen Namen verweist, was Tabelle1 wäre. Damit kommt der Fehler nicht mehr aber er kopiert auch keine Werte mehr. Ich kann aber nicht erkennen warum. Hab auch den Test gemacht ein weiteres Blatt (Tabelle2) mit den Namen Tabelle1 zu erstellen. Auch da nimmt er dann die Werte nicht raus.

Macht es Sinn Beispieldateien mal einzustellen oder wäre das zu viel verlangt?
Anzeige
AW: VBA mehrere Dateien öffnen und Bereich kopieren
24.01.2024 12:54:05
UweD
Hallo

Ja lad mal Datei hoch.

Lg UweD
AW: VBA mehrere Dateien öffnen und Bereich kopieren
25.01.2024 09:17:39
UweD
Hallo

- das Makro sollte in ein Normales Modul der .xlsm Datei.
nicht in DieseArbeitsmappe (hier sollen nur EventMakros liegen)

- hier wird dann in einem Neuen Tabellenblatt unten angefügt



- Die .xls Datei muss in deinem Fall in C:\Uebergabe\



Ich habe Beides bei mir nachgestellt und es funktioniert Ohne Änderung am Code

LG UweD
Anzeige
AW: VBA mehrere Dateien öffnen und Bereich kopieren
25.01.2024 12:44:58
R
Hallo UweD,

Danke es funktioniert!

Jetzt wo Du es geschrieben hast, ja Vorgestern (wo es ging) hatte ich es auch ins Modul geschrieben weil ich vorher was probiert hatte.
Das hatte ich aber gar nicht auf dem Schirm.

Vielen Dank für die Lösung
AW: VBA mehrere Dateien öffnen und Bereich kopieren
23.01.2024 12:48:17
UweD
Hallo nochmal

Die Frage hat sich erübrigt. Das hattest du ja bereits beschrieben.


Hier Meine Lösung: 

Sub alle_Dateien_Verzeichnis() '

    On Error GoTo Fehler

    Dim Pfad As String, Ext As String, Datei As String

    Dim Spz As Integer, LR As Long

    Dim WB As Workbook, TBN As Worksheet, TBx As String, RNG As String

    

    Ext = "*.xls*"

    Pfad = "D:\excel\Temp\Test\" '**** mit \

    

    Spz = 1 'Zielspalte A

    

    TBx = "AA" 'Quellblatt

    RNG = "O5:O14"

    

    'Neues Zielblatt

    Set TBN = ThisWorkbook.Sheets.Add(after:=Sheets(Sheets.Count))



    'Alle Dateien durchlaufen

    Datei = Dir(Pfad & Ext)

    Do While Len(Datei) > 0

    

        Set WB = Workbooks.Open(Filename:=Pfad & Datei)

        

        

        LR = TBN.Cells(TBN.Rows.Count, Spz).End(xlUp).Row 'letzte Zeile der Spalte

    

        'Bereich kopieren

        Sheets(TBx).Range(RNG).Copy TBN.Cells(LR + 1, Spz)

        

        Workbooks(Datei).Close False 'Schließen ohne Speichern

        

        Datei = Dir() ' nächste Datei

    Loop

    

    

    Err.Clear

Fehler:

    If Err.Number > 0 Then MsgBox "Fehler: " & _

        Err.Number & vbLf & Err.Description: Err.Clear



End Sub

LG UweD
Anzeige
AW: VBA mehrere Dateien öffnen und Bereich kopieren
23.01.2024 12:55:33
R
@UweD: nur ein paar wäre die bessere Lösung.
(Derzeit habe ich allerdings alle, was auch gehen würde)

Links zu Excel-Dialogen

Frame

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige