Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1912to1916
1912to1916
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Kopieren von allen Tabellenblätter

Forumthread: Kopieren von allen Tabellenblätter

Kopieren von allen Tabellenblätter
06.01.2023 12:18:18
allen
Hallo zusammen,
ich möchte aus allen Tabellenblätter in meiner Datei in einer Übersicht zusammen kopieren. Immer fängt der Bereich bei A6 un endet bei T50.
Hat jemand eine Idee? Wie ich das in VB umsetzen kann?
Anzeige

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren von allen Tabellenblätter
06.01.2023 12:56:46
allen
Hallo Thorsten,
wo - in welchen Zellen - der Tabelle "Übersicht" sollen die Daten ?
Gruß Gerd
AW: Kopieren von allen Tabellenblätter
06.01.2023 14:00:03
allen
Auch in Zeile A6 in der Übersicht (also selber Bereich) und natürlich dann untereinander.
AW: Kopieren von allen Tabellenblätter
06.01.2023 14:40:03
allen
Konntest du schon eine Lösung finden?
Anzeige
AW: Kopieren von allen Tabellenblätter
07.01.2023 13:22:14
allen
Hallo
mit diesem kleinen Code sollte es funktionieren. Würde mih freuen wenn es einwandfrei klappt!
PS. ınerwünschte Tabellen die nicht kopiert werden sollen kannst du mit If Then und Tabellen Namen überspringen!
mfg Piet
  • 
Sub Daten_kopieren()
Dim i As Integer, lz1 As Long
With Worksheets("Übersicht")
'zuerst alte Übersicht löschen
lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A6:T" & Rows.Count).Clear
For i = 1 To Worksheets.Count
If Worksheets(i).Name = "nicht kopieren" Then GoTo nx
lz1 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If lz1

    • Anzeige
    AW: Kopieren von allen Tabellenblätter
    10.01.2023 15:02:35
    allen
    Funktioniert genau so wollte ich das danke!
    AW: Kopieren von allen Tabellenblätter
    07.01.2023 13:52:59
    allen
    Hallo Thorsten,
    falls nur die Daten benötigt werden.
    
Option Explicit
Sub Unit()
Dim LZ As Long, LS As Long
Dim arr() As Variant
Dim Wsh As Worksheet
Dim V As Variant
Dim L As Long, S As Long
Dim sp As Long, z As Long
ThisWorkbook.Worksheets("Übersicht").Cells(6, 1).Resize(Rows.Count - 5, 20).ClearContents
LZ = 45 * ThisWorkbook.Worksheets.Count - 1
LS = 20
ReDim arr(1 To LZ, 1 To LS)
For Each Wsh In ThisWorkbook.Worksheets
If Wsh.Name  "Übersicht" Then
V = Wsh.Cells(6, 1).Resize(45, 20).Value
For L = 1 To UBound(V, 1)
z = z + 1
For S = 1 To UBound(V, 2)
sp = sp + 1
If sp = LS + 1 Then sp = 1
arr(z, sp) = V(L, S)
Next
Next
End If
Next
ThisWorkbook.Worksheets("Übersicht").Cells(6, 1).Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub
    Den Namen von Übersicht bitte ggf. anpassen.
    Gruß Gerd
    Anzeige
    AW: Kopieren von allen Tabellenblätter
    10.01.2023 14:43:45
    allen
    Funktioniert! Aber leider kopiert er nur aus einem Tabellenblatt, ich habe ja mehrere. Zur Zeit kopiert er nur aus dem nachfolgenden Tabellenblatt.

    Beliebteste Forumthreads (12 Monate)

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