Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1912to1916
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

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?

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?
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)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige