Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.10.2025 17:40:39
16.10.2025 17:25:38
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Ohne Überschriften Kopieren

Ohne Überschriften Kopieren
06.12.2008 14:09:00
Wolfgang
Hallo,
ich hatte gedacht, das bekäme ich wenigstens hin, leider nicht. Der untenstehende Code kopiert mir alle Datensätze aus den Tabellen1-4 in die Tabelle "Gesamt"; Wie muß ich den Code verändern, damit ich die Überschriften aus Zeile 1 nicht mitkopiert bekomme? - Danke schon jetzt für die Rückmeldung.
Herzliche Grüße
Wolfgang

Sub CopyGesamt()
Dim lngRow As Long, X As Long
lngRow = 1
With Worksheets("Gesamt")
.UsedRange.Delete
For X = 1 To Worksheets.Count
If Worksheets(X).Name = "Tabelle1" Or Worksheets(X).Name = "Tabelle2" Or Worksheets(X).  _
_
Name = "Tabelle3" Or Worksheets(X).Name = "Tabelle4" Then
Worksheets(X).Range("A1").CurrentRegion.Copy .Cells(lngRow, 1)
lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End If
Next
End With
End Sub


Anzeige

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ohne Überschriften Kopieren
06.12.2008 14:31:00
Original
Hi,
führ eine zusätzliche Variable ein:
Dim C As Range
Die Zeile zum Kopieren dann so:
Set C = Worksheets(X).Range("A1").CurrentRegion
C.Offset(1, 0).Resize(C.Rows.Count - 1, C.Columns.Count).Copy
mfg Kurt
Was mache ich noch falsch?
06.12.2008 15:05:49
Wolfgang
Hallo Kurt,
ich habe versucht, Deine Hinweise "einzubauen", was mache ich noch verkehrt? - Der Code kopiert so noch nicht. Danke schon jetzt wieder für Deine Rückmeldung.
Gruß - Wolfgang

Sub CopyGesamt()
Dim C As Range
Dim lngRow As Long, X As Long
lngRow = 1
With Worksheets("Gesamt")
.UsedRange.Delete
For X = 1 To Worksheets.Count
If Worksheets(X).Name = "Tabelle1" Or Worksheets(X).Name = "Tabelle2" Or Worksheets(X).  _
_
Name = "Tabelle3" Or Worksheets(X).Name = "Tabelle4" Then
Set C = Worksheets(X).Range("A1").CurrentRegion
C.Offset(1, 0).Resize(C.Rows.Count - 1, C.Columns.Count).Copy
'Worksheets(X).Range("A1").CurrentRegion.Copy .Cells(lngRow, 1)
lngRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End If
Next
End With
End Sub


Anzeige
AW: Ohne Überschriften kopieren
06.12.2008 14:38:00
Erich
Hallo Wolfgang,
vielleicht so (ungetestet):

Option Explicit
Sub CopyGesamt()
Dim lngRQue As Long, lngRZiel As Long, X As Long
lngRZiel = 1
Worksheets("Gesamt").UsedRange.Delete
For X = 1 To Worksheets.Count
With Worksheets(X)
If .Name = "Tabelle1" Or .Name = "Tabelle2" Or _
.Name = "Tabelle3" Or .Name = "Tabelle4" Then
lngRQue = .Cells(.Rows.Count, 1).End(xlUp).Row
If lngRQue >= 2 Then
.Range(.Rows(2), .Rows(lngRQue)).Copy _
Worksheets("Gesamt").Cells(lngRZiel, 1)
lngRZiel = lngRZiel + lngRQue - 1
End If
End If
End With
Next
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
Danke Erich und Kurt, läuft !
06.12.2008 15:18:00
Wolfgang
Hallo Erich und Kurt,
ich habe Deinen Code, Erich, direkt "eingebaut" und er läuft prima. Dafür herzlichen Dank und auch herzlichen Dank für die schnelle Rückmeldung sowie die Ausarbeitungen; Gleiches gilt auch Dir, Kurt. Meine Frage ist somit sehr gut gelöst und hat sich erledigt. Danke nochmals und noch ein schönes Wochenende.
Gruß - Wolfgang
Anzeige
;

Forumthreads zu verwandten Themen

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