Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Mehrere Tabellen zu einem Druckblatt zusammenführe

Mehrere Tabellen zu einem Druckblatt zusammenführe
04.08.2005 18:51:54
erich
Hallo Excelprofis,
mochmals danke an Christoph M der mir in diesen Forum geholfen und nachfolgenden Code geschrieben hat.

Sub JoinSheets()
Dim wksSrc As Worksheet, wksDst As Worksheet
Dim lngLR As Long
Set wksDst = Sheets("Ausdruck")
For Each wksSrc In ThisWorkbook.Worksheets
lngLR = wksDst.Cells(wksDst.Rows.Count, 1).End(xlUp).Row
If wksSrc.Name <> wksDst.Name Then
wksDst.Cells(lngLR + 1, 1) = wksSrc.Name
wksDst.Cells(lngLR + 1, 1).Font.Size = 24
wksSrc.UsedRange.Copy wksDst.Cells(lngLR + 2, 1)
End If
Next
Set wksDst = Nothing
End Sub

nun zu meinen Problem:
meine Arbeitsmappe ist um einige tabellen größer geworden ich möchte aber nur die Tabellen (Offene Klasse, Schülerklasse... wie in der Beispielmappe in die Tabelle "Ausdruck" kopieren.
was muss ich ändern, ich bitte euch um hilfe.
P.S. Sollte es möglich sein hätte ich noch ne bitte, das keine formeln mit Kopiert werden sondern nur die Werte.
Für Eure Hilfe danke ich euch schon im Vorraus.
Gruß
Erich
https://www.herber.de/bbs/user/25243.xls
Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mehrere Tabellen zu einem Druckblatt zusammenführe
04.08.2005 19:46:56
Herbert
hallo Erich,
probier diesen Ansatz...


Option Explicit
Sub x()
Dim sh As Worksheet, ez%, lz%, i%, z%
Set sh = Sheets("Ausdruck")
ez = 2
Application.ScreenUpdating = False
With sh.Cells(1, 1)
    .Value = Sheets(i + 1).Name
    .Font.Size = 24
    .RowHeight = 30
End With
For i = 1 To 4
  lz = Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row + z
  If i = 1 Then lz = lz + 1
      
      sh.Range("A" & ez & ":o" & lz).Value = _
      Sheets(i).Range("a1:o" & lz).Value
      
      With sh.Cells(lz + 1, 1)
           .Value = Sheets(i + 1).Name
             If i = 4 Then .Value = ""
           .Font.Size = 24
           .RowHeight = 30
      End With
      
   ez = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
   z = lz + 1
Next
Application.ScreenUpdating = True
End Sub

     gruß Herbert
Anzeige
Danke
04.08.2005 20:57:58
Erich
Danke Herbert für deine hilfe
gruß
erich
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige