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!
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
Hallo Chris,
danke für die schnelle und ausfürliche Antwort.
Werde mal alles ausprobieren.
Melde mich dann wieder.
Gruß Skaletti!
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
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
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!
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!
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
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!
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
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!
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
1 „Gefällt mir“
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!