1.9k Aufrufe
Gefragt in Tabellenkalkulation von
Hallo, Ich habe in einem Verzeichnis mehrere Xlsx Dateien.
In diesen Dateien ist ein Reiter (Tabelle1). In diesem Reiter ist eine Tabelle welche idR auf B4 beginnt und bis V85 geht. Die letzte Zeile kann aber auch eine andere sein.

Ich möchte gerne über VBA
- Den aktiven/ genutzen Bereich der jeweiliegen Tabelle kopieren
- Diesen dann jeweils auch als Tabelle in eine neue Datei untereinander eintragen.

Ziel: Die Inhalte jeder einzelnen Tabelle finden sich als eine große Tabelle in einer neuen Datei wieder.

Ich hoffe ihr könnt mir helfen.

Vielen Dank dafür.

VG/W

6 Antworten

0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi :-)

wie gewuenscht

gruss nighty

pad ist anzupassen

Sub DateienLesen()
Call EventsOff
Dim DateiName As String
DateiName = Dir("C:\Temp\" & "*.xlsx")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp\" & DateiName
Workbooks(DateiName).Worksheets(1).Range("B4:V" & Workbooks(DateiName).Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row).Copy _
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1)
Workbooks(DateiName).Close SaveChanges:=True
End If
DateiName = Dir
Loop
Call EventsOn
End Sub

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
0 Punkte
Beantwortet von
Hallo Nighty,

ich bin begeistert.
Die Anwendung möchte von mir nun das ich Verknüpfungen aktualisiere.
Kann ich das Ausschalten bzw. verhindern?

VGuvD. W
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi :commnity :-)

war natuerlich meine schuld hihi

ist aendere das nacher ,das nur werte uebertragen werden

gruss nighty
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi :-)

die variante der werte uebertragung

gruss nighty

Sub DateienLesen()
Call EventsOff
Dim DateiName As String
DateiName = Dir("C:\Temp\" & "*.xlsx")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp\" & DateiName
Workbooks(DateiName).Worksheets(1).Range("B4:V" & Workbooks(DateiName).Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone
Workbooks(DateiName).Close SaveChanges:=True
End If
DateiName = Dir
Loop
Call EventsOn
End Sub

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
0 Punkte
Beantwortet von
Hallo Nighty,

besser kann ich VBA nicht lernen.

Noch eine Frage.

Mit Call EventsOff werden Anzeigen Ausgeschaltet.

Ich bekomme aber immer noch die Fragen "Zwischenspeicher leeren" und " Feld aktualisieren"
(je nachdem ob in der Tabelle eine Verknüpfung abgefragt wird)

Was kann ich machen das diese Fragen unterdrückt bzw. automatische beantwortet werden.

Vielen Dank für die Hilfe.

VG/W
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi :-)

ergaenze die 2 kleinen module durch

Application.DisplayAlerts = False

und das zweite

Application.DisplayAlerts = True

gruss nighty
...