Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
644to648
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
644to648
644to648
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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

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

224 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige