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

"Tabelle1" aller Verzeichnismappen untereinander

"Tabelle1" aller Verzeichnismappen untereinander
19.09.2018 20:19:47
Toni
Hallo liebe Excelfreunde,
auf der Suche nach einem Code, der mir sämtliche Mappen eines Verzeichnisses öffnet und die jeweils aktiven Tabellen in die den Code ausführende Mappe in dass Blatt "Tabelle1" untereinander kopiert bin ich fündig geworden. Die Code-Mappe liegt im selben Verzeichnis wie die zu kopierenden Mappen. Der Code kommt von Beverly: auf "supportnet" entdeckt - ich sage mal Danke über drei Ecken :).
Jetzt wäre es schön, wenn mir nicht die gerade aktive Tabelle der geöffneten Mappen sondern nur die mit dem Namen "SoEinSpaß" kopiert werden.
Das wäre mir eine große Hilfe!
Sub zusammenfuegen()
Dim strDateiname As String
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim inLetzte As Integer
Application.ScreenUpdating = False
strDateiname = Dir(ThisWorkbook.Path & "\*.xlsx")
With ThisWorkbook.Worksheets("Tabelle1")
Do While strDateiname  ""
If strDateiname  ThisWorkbook.Name Then
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strDateiname
loLetzte1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
loLetzte2 = ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells( _
xlCellTypeLastCell).Row
inLetzte = ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell) _
.Column
ActiveWorkbook.ActiveSheet.Range(Cells(3, 1), Cells(loLetzte2, inLetzte)).Copy  _
Destination:=.Cells(loLetzte1 + 1, 1)
ActiveWorkbook.Close True
End If
strDateiname = Dir
Loop
End With
Application.ScreenUpdating = True
End Sub

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

Betreff
Datum
Anwender
Anzeige
AW: "Tabelle1" aller Verzeichnismappen untereinander
19.09.2018 20:58:46
Toni
That's it:
Sub zusammenfuegen()
Dim strDateiname As String
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim inLetzte As Integer
Application.ScreenUpdating = False
strDateiname = Dir(ThisWorkbook.Path & "\*.xlsx")
With ThisWorkbook.Worksheets("Tabelle1")
Do While strDateiname  ""
If strDateiname  ThisWorkbook.Name Then
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strDateiname
Worksheets("SoEinSpaß").Activate
loLetzte1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
loLetzte2 = ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells( _
xlCellTypeLastCell).Row
inLetzte = ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell) _
.Column
ActiveWorkbook.ActiveSheet.Range(Cells(3, 1), Cells(loLetzte2, inLetzte)).Copy  _
Destination:=.Cells(loLetzte1 + 1, 1)
ActiveWorkbook.Close True
End If
strDateiname = Dir
Loop
End With
Application.ScreenUpdating = True
End Sub
wer suchet der findet ...
Anzeige
AW: "Tabelle1" aller Verzeichnismappen untereinander
20.09.2018 09:04:34
Torsten

Sub zusammenfuegen()
Dim strDateiname As String
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim inLetzte As Integer
Application.ScreenUpdating = False
strDateiname = Dir(ThisWorkbook.Path & "\*.xlsx")
With ThisWorkbook.Worksheets("Tabelle1")
Do While strDateiname  ""
If strDateiname  ThisWorkbook.Name Then
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strDateiname
loLetzte1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
loLetzte2 = ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells( _
xlCellTypeLastCell).Row
inLetzte = ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells( _
xlCellTypeLastCell).Column
ActiveWorkbook.Sheets("SoEinSpaß").Range(Cells(3, 1), Cells(loLetzte2,  _
inLetzte)).Copy Destination:=.Cells(loLetzte1 + 1, 1)
ActiveWorkbook.Close True
End If
strDateiname = Dir
Loop
End With
Application.ScreenUpdating = True
End Sub

Anzeige
Danke für diese Variante,
20.09.2018 10:31:59
Toni
denn als Einbindung in Objekthierarchie ist siemir so verständlicher .
Außerdem ist das allseits gescholtene Activate damit umgangen...
Grüße Torsten!
AW: Danke für diese Variante,
21.09.2018 10:07:08
Torsten
gerne und danke fuer die Rueckmeldung
Gruss Torsten

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige