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

Tabellenblätter nebeneinander kopieren

Tabellenblätter nebeneinander kopieren
03.11.2012 09:39:32
Gallanz
Hallo,
ich möchte 8 bestimmte Tabellenblätter aus einem Excel Dokument in ein neues kopieren (ca 30 Tabellenblätter insgesamt). Dabei soll der Inhalt in ein Tabellenblatt zusammengeführt werden - also nebeneinander.
Range aller 8 Blätter: A1:CF550
Die Bezeichnung der 8 Tabellenblätter sollte am besten in Spalte A aufgeführt werden um nicht die Übersicht zu verlieren.
Gallanz

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellenblätter nebeneinander kopieren
03.11.2012 10:11:26
Hajo_Zi
derv erste Bereich soll als in A31:Cf..., der zweite bereiuch in CG31:...
Erster Tabellename in A1
zweiter Tabellename in A2
habe ich das richtig verstanden?

AW: Tabellenblätter nebeneinander kopieren
03.11.2012 10:28:00
Gallanz
Die zu kopierenden Zellen sind: A1:CF550
So soll das aussehen:
A1:Name von Tabellenblatt 1
A2:CF551 die kopierten Daten Tabellenblatt 1
CH1: Name von Tabellenblatt 2
CH2:FH551 (müsste FH sein, wenn ich mich nicht verzählt habe) die kopierten Daten von Tabellenblatt 2
usw

AW: Tabellenblätter nebeneinander kopieren
03.11.2012 10:30:44
Hajo_Zi
Also soll der Tabnellenname nicht immer in Spalte A?
Hast Du mal das Makro vopn Tino getestet?
Gruß Hajo

Anzeige
AW: Tabellenblätter nebeneinander kopieren
03.11.2012 11:02:44
Gallanz
Hast recht, soll immer in Zeile 1, ab Zeile 2 dann die Daten.
Gallanz

AW: Tabellenblätter nebeneinander kopieren
03.11.2012 10:13:17
Tino
Hallo,
Du hast VBA nein angegeben, ob dies ohne VBA geht kann ich mir nicht vorstellen.
Hier mal eine erste Variante.
Der Code kommt in ein Standard Modul.
Starten kannst Du den Code über einen Button den Du diesen Code zuweist.
Den Bereich wo die Tabellen gelistet sind, müsstest Du evtl. noch anpassen.
Sub KopiereTabellen()
Dim rngTabellen As Range, rngLetzte As Range, strRange$
Dim NewWB As Workbook
Dim strFehler$

'Quelle der Tabellen 
Set rngTabellen = Tabelle1.Range("A2:A9")
'zu kopierender Bereich 
strRange = "A1:CF550"

For Each rngTabellen In rngTabellen.Cells
    If CheckTab(rngTabellen.Value) Then
        If NewWB Is Nothing Then Set NewWB = Workbooks.Add(1)
        With NewWB.Worksheets(1)
            Set rngLetzte = .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row, 1)
            ThisWorkbook.Sheets(rngTabellen.Value).Range(strRange).Copy rngLetzte
        End With
    Else
        strFehler = strFehler & Chr(7) & rngTabellen.Value & vbCr
    End If
Next rngTabellen

If strFehler <> "" Then
    MsgBox "Tabellen wurden nicht gefunden!" & vbCr & vbCr & Left$(strFehler, Len(strFehler) - 1)
End If
End Sub

Function CheckTab(strTabname$) As Boolean
On Error Resume Next
CheckTab = IsNumeric(ThisWorkbook.Sheets(strTabname).Index)
End Function
Gruß Tino

Anzeige
AW: Tabellenblätter nebeneinander kopieren
03.11.2012 11:01:58
Gallanz
Hallo Tino,
leider bekomme ich die Fehlermeldung: "Tabellen nicht gefunden"
Btw, Tabellennamen sollen nicht in Spalte A sondern in Zeile 1 gelistet werden, sonst macht das natürlich auch keinen Sinn.

AW: Tabellenblätter nebeneinander kopieren
03.11.2012 11:06:49
Tino
Hallo,
pass doch den Bereich an (bei Quelle der Tabellen) wo diese bei dir stehen.
Gruß Tino

AW: Tabellenblätter nebeneinander kopieren
03.11.2012 11:32:09
Gallanz
Hie mal ein einfaches Beispiel wie es aussehen soll
https://www.herber.de/bbs/user/82462.xlsx
Die ersten 3 Tabellenblätter sind die Ausgangsdaten.
Das Tabellenblatt "Die erstellte Arbeitsmappe" soll in einer neuen Excel Datei erstellt werden

Anzeige
AW: Tabellenblätter nebeneinander kopieren
03.11.2012 12:04:29
Tino
Hallo,
versuch es mal so.
Datei muss als xlsm gespeichert werden, xlsx kann kein VBA.
https://www.herber.de/bbs/user/82463.xlsm
Gruß Tino

AW: Tabellenblätter nebeneinander kopieren
03.11.2012 12:12:34
Matze,Matthias
Hi ,
kleiner Tippfehler bei:
dies: NewWB.Worksheets(1).UsedRange.entirColumn.AutoFit
ersetzen: NewWB.Worksheets(1).UsedRange.EntireColumn.AutoFit
Matze
Ps der Button kopiert sich mit ?

AW: Tabellenblätter nebeneinander kopieren
03.11.2012 12:22:02
Gallanz
Sry für meine Unfähigkeit, VBA ist nicht wirklich mein Fachgebiet.
Ich habe aus deiner datei den folgenden Code
Option Explicit
Sub KopiereTabellen()
Dim Tabelle As Worksheet, Tabellen()
Dim rngLetzte As Range, strRange$
Dim NewWB As Workbook
'Tabellen erweitern oder und anpassen
Tabellen = Array("Tabelle1", "Tabelle2", "Tabelle3")
'zu kopierenter Bereich
strRange = "A1:CF550"
For Each Tabelle In ThisWorkbook.Sheets(Tabellen)
If NewWB Is Nothing Then
Set NewWB = Workbooks.Add(1)
End If
With NewWB.Worksheets(1)
If rngLetzte Is Nothing Then
Set rngLetzte = .Cells(2, 1)
Else
Set rngLetzte = .Cells(2, .Columns.Count).End(xlToLeft).Offset(, 2)
End If
rngLetzte.Offset(-1, 0) = Tabelle.Name
Tabelle.Range(strRange).Copy rngLetzte
End With
Next Tabelle
If Not NewWB Is Nothing Then
NewWB.Worksheets(1).UsedRange.entircolumn.AutoFit
End If
End Sub
Function CheckTab(strTabname$) As Boolean
On Error Resume Next
CheckTab = IsNumeric(ThisWorkbook.Sheets(strTabname).Index)
End Function
&
Option Explicit
Sub Makro1()
' Makro1 Makro
Sheets(Array("Tabelle1", "Tabelle3")).Select
Sheets("Tabelle1").Activate
End Sub
Beim 1. habe ich aus

Tabellen = Array("Tabelle1", "Tabelle2", "Tabelle3")

Tabellen = Array("Tabelle29", "Tabelle31", "Tabelle32", "Tabelle33", "Tabelle34", "Tabelle35", "Tabelle36", "Tabelle37")
gemacht
Was muss beim 2. geändert werden?
Gallanz

Anzeige
AW: Tabellenblätter nebeneinander kopieren
03.11.2012 12:55:21
Matze,Matthias
Hallo,
das Modul kannst du löschen, rechte mastaste auf das Modul/entfernen
wenn Abfrage kommt mit Nein bestätigen
Matze

AW: Tabellenblätter nebeneinander kopieren
03.11.2012 13:06:35
Gallanz
Bekomme folgende Fehlermeldung:
Index außerhalb des gültigen Bereichs (Fehler 9)

AW: Tabellenblätter nebeneinander kopieren
03.11.2012 14:44:29
Matze,Matthias
Poste deinen Code, wir wissen NICHT was du da alles änderst.
Matze

AW: Tabellenblätter nebeneinander kopieren
03.11.2012 15:10:25
Gallanz

Option Explicit
Sub KopiereTabellen()
Dim Tabelle As Worksheet, Tabellen()
Dim rngLetzte As Range, strRange$
Dim NewWB As Workbook
'Tabellen erweitern oder und anpassen
Tabellen = Array("Tabelle29", "Tabelle31", "Tabelle32", "Tabelle33", "Tabelle34", "Tabelle35" _
, "Tabelle36", "Tabelle37")
'zu kopierenter Bereich
strRange = "A1:CF550"
For Each Tabelle In ThisWorkbook.Sheets(Tabellen)
If NewWB Is Nothing Then
Set NewWB = Workbooks.Add(1)
End If
With NewWB.Worksheets(1)
If rngLetzte Is Nothing Then
Set rngLetzte = .Cells(2, 1)
Else
Set rngLetzte = .Cells(2, .Columns.Count).End(xlToLeft).Offset(, 2)
End If
rngLetzte.Offset(-1, 0) = Tabelle.Name
Tabelle.Range(strRange).Copy rngLetzte
End With
Next Tabelle
If Not NewWB Is Nothing Then
NewWB.Worksheets(1).UsedRange.entircolumn.AutoFit
End If
End Sub
Function CheckTab(strTabname$) As Boolean
On Error Resume Next
CheckTab = IsNumeric(ThisWorkbook.Sheets(strTabname).Index)
End Function

Anzeige
AW: Tabellenblätter nebeneinander kopieren
03.11.2012 15:16:44
Matze,Matthias
Ha du liest nur die Hälfte der Beiträge die man dir schreibt:
ich hatte darrauf hingewiesen das in diesen Code ein Tippfehler ist:
ersetze: NewWB.Worksheets(1).UsedRange.entircolumn.AutoFit
durch : NewWB.Worksheets(1).UsedRange.Entirecolumn.AutoFit

Und mach mal wegen besser Lesbarkeit nach den End Sub eine Leerzeile
Matze

AW: Tabellenblätter nebeneinander kopieren
03.11.2012 17:12:16
Gallanz
Cool, danke!

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige