Nur Werte kopieren und in neue Tabelle einfügen

[Skaletti_1658ca]

Hallo ihr netten Leute im Forum.

Bisher konntet ihr mir immer helfen.
Ich habe erstmal eine grundsätzliche Frage:
Ich habe eine Arbeitsmappe mit 40 Tabellenblättern.
Ich möchte gerne das bei allen Tabellenblättern,z.B. Range A1:I22,
nur die Werte kopiert werden, und alles zusammen in eine andere Tabelle kopiert wird.(Nur Text, keine Formatierung oder Formel)
Da das öfter geschehen soll, wäre jede Tabelle einzel kopieren und einfügen sehr aufwendig.
Ist das machbar, mit einem Makro???

Gruß Skaletti!

[anon62718186]

Also, im Prinzip ist das schon möglich.

Wenn es sich immer um den gleichen Bereich handelt, der kopiert werden muß, ist das überhaupt kein Problem.

Diese Funktion bearbeitet alle („each“) Arbeitsblätter.

sub copy\_range\_allsheets
 const RangeToCopy = "A2:I22"

 for each sheet in Thisworkbook.sheets
 Range(RangeToCopy).Copy
 next
end sub

Diese bearbeitet gezielt bestimmte Tabellen

sub copy\_range\_specifiedsheets
 const RangeToCopy = "A2:I22"

 Sheets("Tabelle1").Range(RangeToCopy).Copy 
 Sheets("Tabelle6").Range(RangeToCopy).Copy 
 Sheets("Tabelle13").Range(RangeToCopy).Copy 

end sub

Diese Funktionen kopieren lediglich die Inhalte.
Der Clou ist dann die Funktion PasteSpecial

sub paste\_data
' Die Zelle C4 beschreibt die obere linke zelle des Zielfeldes; es wird also ab C4 alles passend eingefügt
 Sheets("Zieltabelle").Range("C4").PasteSpecial Paste:=xlPasteValues
end sub

Wenn pro Tabelle immer andere Bereiche kopiert werden müssen, so nimmst du statt RangeToCopy immer gezielt die zu kopierenden Bereiche; kannst aber eben die ForEach Funktion nicht verwenden.

LG
Chris

[Skaletti_1658ca]

Hallo Chris,

danke für die schnelle und ausfürliche Antwort.
Werde mal alles ausprobieren.
Melde mich dann wieder.

Gruß Skaletti!

[Reinhard_fb8cb7]

Hallo Chris,

Diese Funktion bearbeitet alle („each“) Arbeitsblätter.
sub copy_range_allsheets
const RangeToCopy = „A2:I22“
for each sheet in Thisworkbook.sheets
Range(RangeToCopy).Copy
next
end sub

? Völlig ungetestet behaupte ich ma, das kann nie und nimmer klappen.
Angenommen es sind 12 Sheets, so wird da 12mal der genannte Bereich des aktiven Blattes kopiert.
Kopiert nirgendwohin.

PS: Davon abgeshen, bei allen deinen Codes würde mein Debugger gewaltig meckern.

Diese bearbeitet gezielt bestimmte Tabellen
sub copy_range_specifiedsheets
const RangeToCopy = „A2:I22“
Sheets(„Tabelle1“).Range(RangeToCopy).Copy
Sheets(„Tabelle6“).Range(RangeToCopy).Copy
Sheets(„Tabelle13“).Range(RangeToCopy).Copy
end sub

Klappt schon eher, aber wohin wird kopiert?

Wenn pro Tabelle immer andere Bereiche kopiert werden müssen,
so nimmst du statt RangeToCopy immer gezielt die zu
kopierenden Bereiche; kannst aber eben die ForEach Funktion
nicht verwenden.

? Möglicherweise hilft dem Anfrager grad eine For each-Schleife um das Problem zu lösen *annehm*

Gruß
Reinhard

[Reinhard_fb8cb7]

Hallo Skaletti,

Hallo ihr netten Leute im Forum.
Bisher konntet ihr mir immer helfen.

mal so daher gesagt und vielleicht als Inspiration, hier gibt es viele Bretter. Vielleicht kannst du in anderen Themengebieten Anderen helfen? Nur mal so als Idee.

Ich habe eine Arbeitsmappe mit 40 Tabellenblättern.
Ich möchte gerne das bei allen Tabellenblättern,z.B. Range
A1:I22,
nur die Werte kopiert werden, und alles zusammen in eine
andere Tabelle kopiert wird.(Nur Text, keine Formatierung oder
Formel)

Probier dieses mal (ungetestet):

Sub Kopier()
Dim wks As Worksheet, Zei As Long
Worksheets.Add after:=Worksheets(Worksheets.Count)
For Each wks In ThisWorkbook.Worksheets
 If wks.Name ActiveSheet.Name Then
 Zei = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
 wks.Range("A1:I22").Copy Destination:=ActiveSheet.Range("A" & Zei)
 End If
Next wks
End Sub

Gruß
Reinhard

[Skaletti_1658ca]

Hallo Reinhard,

danke für die schnelle Antwort.
Werde auch deinen Code ausprobieren.

mal so daher gesagt und vielleicht als Inspiration, hier gibt
es viele Bretter. Vielleicht kannst du in anderen
Themengebieten Anderen helfen? Nur mal so als Idee.

Deine Inspirarion werde ich aufgreifen, und mir auch mal andere Bretter anschauen (Zeit). Ich würde sehr gerne helfen, wenn möglich. Als Einsteiger Exel/VBA bin ich leider noch nicht so weit, aber auch hier schau ich (fast) täglich die Fragen durch. Irgendwann blitzt es dann bestimmt auch bei mir.

Gruß
Skaletti!

[Skaletti_1658ca]

Hallo Chris,
Hallo Reinhard,

Chris, habe deine Makros getestet.
Da ich doch Einzel- und Mannschaftstabellen unterscheiden muss,
wäre dein 2. Makro zu gebrauchen.(einmal für Einzeltabellen und einmal für Mannschaftstabellen.)

Sub copy\_range\_specifiedsheets()
 Const RangeToCopy = "A1:I15"'Range ändern nach Bedarf

 Sheets("LG frei Schüler Einzel").Range(RangeToCopy).Copy
 Sheets("LG frei Jugend Einzel").Range(RangeToCopy).Copy
 Sheets("LG frei Junioren Einzel").Range(RangeToCopy).Copy
'u.s.w.
End Sub

Man könnte dann per Mausklick die Inhalte (nur Text) in eine andere Tabelle einfügen. Kopiert wird leider nur immer das zuletzt aufgeführte Sheet, und auch mit allen Formatierungen.
Mit solch einer Lösung könnte ich eventuell leben, wenn alle aufgeführten Tabellen kopiert werden können.
Vielen Dank für deine Hilfe.

Reinhard,dein Makro funktioniert gut.
Es wird alles kopiert und eine neue Tabelle wird auch angelegt.
Allerdings werden auch hier alle Formatierungen mitkopiert.
Brauche nur die Inhalte,Text.
Es müsste auch in diesem Fall zwischen Einzel- und Mannschaftstabellen unterschieden werden.(andere Spaltenaufteilung)
(„LG frei Junioren Einzel“)(„LG frei Junioren Mannsch.“).
Die Entbezeichnungen wären immer gleich: 22 mal „Einzel“
18 mal "Mannsch.
Wäre das möglich??
Vielen Dank.
Gruß Skaletti!

[Reinhard_fb8cb7]

Hallo Skaletti,

Es wird alles kopiert und eine neue Tabelle wird auch
angelegt.
Allerdings werden auch hier alle Formatierungen mitkopiert.
Brauche nur die Inhalte,Text.

Sub Kopier()
Dim wks As Worksheet, Zei As Long
Worksheets.Add after:=Worksheets(Worksheets.Count)
For Each wks In ThisWorkbook.Worksheets
 If wks.Name ActiveSheet.Name Then
 Zei = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
 wks.Range("A1:I22").Copy
 ActiveSheet.Range("A" & Zei).PasteSpecial Paste:=xlValues, \_
 Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 End If
Next wks
End Sub

Es müsste auch in diesem Fall zwischen Einzel- und
Mannschaftstabellen unterschieden werden.(andere
Spaltenaufteilung)
(„LG frei Junioren Einzel“)(„LG frei Junioren Mannsch.“).
Die Entbezeichnungen wären immer gleich: 22 mal „Einzel“
18 mal "Mannsch.
Wäre das möglich??

Möglich ist vieles, aber dazu mußt du erstmal „andere Spaltenaufteilung“ genauer definieren.
Prinzipiell vielleicht so:

Sub Kopier2()
Dim wks As Worksheet, Zei As Long
Worksheets.Add after:=Worksheets(Worksheets.Count)
For Each wks In ThisWorkbook.Worksheets
 If wks.Name ActiveSheet.Name Then
 If Right(wks.Name,6)="Einzel" Then
 'Kopiere so
 Else
 'Kopiere anders
 End If
 End If
Next wks
End Sub

Gruß
Reinhard

[Skaletti_1658ca]

Hallo Reinhard,
erstmal vielen Dank.
Kopieren nur Text funktioniert prima. So wie gedacht. Sehr gut.

Möglich ist vieles, aber dazu mußt du erstmal „andere
Spaltenaufteilung“ genauer definieren.

Wenn ich das Range bis Spalte M (A1:M22)erweitere habe ich auch die Mannschaftstabellen komplett.(mehr Spalten als Einzel)
Die Mannschaftstabellen haben nur eine andere Spaltenbreite.

Voneinander getrennt wäre zwar einfacher.

Ich käme allerdings auch so zurecht, da nur ich diese Prozedur ausführe, und nicht ein Anwender. Nehme die Mannschaften dann in eine andere Tabelle.

Gruß Skaletti!

[Reinhard_fb8cb7]

Hallo Skaletti,

Kopieren nur Text funktioniert prima. So wie gedacht. Sehr
gut.

Dankeschön.
Selbst bei so einem kleinen Code ist es gar nicht so einfach daß nur so aus dem Kopf heraus zu schreiben daß es später auch funktioniert.
Es gibt da viele Kleinigkeiten die man nicht bedenkt und schwupps klappt der Code nicht.
Macht aber nix, wenn da entsprechende Rückmeldung kommt kann ich ja den Code selbst testen und verbessern.
Um so mehr freut es mich wenn er gleich klappt ohne daß ich ihn getestet habe.

Möglich ist vieles, aber dazu mußt du erstmal „andere
Spaltenaufteilung“ genauer definieren.

Wenn ich das Range bis Spalte M (A1:M22)erweitere habe ich
auch die Mannschaftstabellen komplett.(mehr Spalten als
Einzel)
Die Mannschaftstabellen haben nur eine andere Spaltenbreite.

Aha, die Mannschaftstabellen haben nur paar mehr Spalten als die Einzeldinger?
Das ist aber was anderes als andere Spaltenaufteilung!

Voneinander getrennt wäre zwar einfacher.

? Wer, wo, wie, watt?

Ich käme allerdings auch so zurecht, da nur ich diese Prozedur
ausführe, und nicht ein Anwender. Nehme die Mannschaften dann
in eine andere Tabelle.

Was bedeutet dies nun für einen evtl. Makrocode?

Gruß
Reinhard

[Skaletti_1658ca]

Hallo Reinhard,

Dankeschön.
Selbst bei so einem kleinen Code ist es gar nicht so einfach
daß nur so aus dem Kopf heraus zu schreiben daß es später auch
funktioniert.
Es gibt da viele Kleinigkeiten die man nicht bedenkt und
schwupps klappt der Code nicht.

Du hast es drauf.
Das möchte ich auch mal können! Dauert noch ein paar Jahre!

Aha, die Mannschaftstabellen haben nur paar mehr Spalten als
die Einzeldinger?
Das ist aber was anderes als andere Spaltenaufteilung!

Mehr Spalten und andere Spaltenbreite. Spalten A bis M.

Voneinander getrennt wäre zwar einfacher.

? Wer, wo, wie, watt?

Gemeint ist: einmal Einzeltabellen kopieren, und einmal Mannschaftstabellen extra kopieren.(2 Tabellen)

Ich käme allerdings auch so zurecht, da nur ich diese Prozedur
ausführe, und nicht ein Anwender. Nehme die Mannschaften dann
in eine andere Tabelle.

Wenn das Makro so bleibt wie es jetzt ist, käme ich auch zurecht.
Ist nur ein bischen mehr Arbeit.
Ideal wäre allerdings 2 Tabellen.

Gruß Skaletti!

[Reinhard_fb8cb7]

Hallo Skaletti,

machen wir so weiter wie bisher
Ich schreib den Code, du testest und sagst klappt oder klappt nicht. *gg*
Sorry, bin 'ne faule Socke *lächel*

Sub Kopier()
Dim wks As Worksheet, Zei As Long
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "E"
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "M"
For Each wks In ThisWorkbook.Worksheets
 If wks.Name ActiveSheet.Name Then
 If Right(wks.Name, 6) = "Einzel" Then
 Zei = Worksheets("E").Range("A" & Rows.Count).End(xlUp).Row + 1
 wks.Range("A1:I22").Copy
 Worksheets("E").Range("A" & Zei).PasteSpecial Paste:=xlValues, \_
 Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Else
 Zei = Worksheets("M").Range("A" & Rows.Count).End(xlUp).Row + 1
 wks.Range("A1:M22").Copy
 Worksheets("M").Range("A" & Zei).PasteSpecial Paste:=xlValues, \_
 Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 End If
 End If
Next wks
End Sub

Gruß
Reinhard

[Skaletti_1658ca]

Hallo Reinhard,

Einfach perfekt!!!
Code schreiben, ohne zu testen und funzt hervorragend!
Besser gehts nicht.

Habe durch dieses Forum schon unendlich viel gelernt.
Ist besser als jedes Buch.

Vielen Dank für die super Hilfe.

Wünsche dir noch ein schönes Wochenende.

Gruß Skaletti!