Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

1 Makro über mehrere Tabellenblätter ausführen lassen

3,637 views
Skip to first unread message

ernsthj

unread,
Jul 6, 2009, 9:31:01 AM7/6/09
to

Ich möchte 1 vorhandenes Makro, welches auf 1 Tabellenblatt arbeitet als
Grundlage benutzen um nacheinander auf mehreren Tabellenblättern dieses Makro
ausführen lassen ohne jedesmal dqs vorhandene Makro erneut aufrufen zu müssen.

Claus Busch

unread,
Jul 6, 2009, 9:37:29 AM7/6/09
to
Hallo Ernst,

Am Mon, 6 Jul 2009 06:31:01 -0700 schrieb ernsthj:

> Ich m�chte 1 vorhandenes Makro, welches auf 1 Tabellenblatt arbeitet als
> Grundlage benutzen um nacheinander auf mehreren Tabellenbl�ttern dieses Makro
> ausf�hren lassen ohne jedesmal dqs vorhandene Makro erneut aufrufen zu m�ssen.

dann mache eine Schleife �ber alle Tabellenbl�tter, z.B.:

For i = 1 to sheets.count
'hier dein Code (aber bitte sauber referenzieren)
next

Da du deinen Code nicht mitgepostet hast, kann man dir keine exakte
Hilfestellung geben.


Mit freundlichen Gr�ssen
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

ernsthj

unread,
Jul 6, 2009, 9:55:01 AM7/6/09
to

"Claus Busch" wrote:

> Hallo Ernst,
>
> Am Mon, 6 Jul 2009 06:31:01 -0700 schrieb ernsthj:
>

> > Ich möchte 1 vorhandenes Makro, welches auf 1 Tabellenblatt arbeitet als
> > Grundlage benutzen um nacheinander auf mehreren Tabellenblättern dieses Makro
> > ausführen lassen ohne jedesmal dqs vorhandene Makro erneut aufrufen zu müssen.
>
> dann mache eine Schleife über alle Tabellenblätter, z.B.:


>
> For i = 1 to sheets.count
> 'hier dein Code (aber bitte sauber referenzieren)
> next
>
> Da du deinen Code nicht mitgepostet hast, kann man dir keine exakte
> Hilfestellung geben.
>
>

> Mit freundlichen Grüssen


> Claus Busch
> --
> Win XP PRof SP2 / Vista Ultimate SP2
> Office 2003 SP2 /2007 Ultimate SP2
>

Danke für die schnelle Antwort.
Es handelt sich bei dem Makro um mehrere Sortierungen in eigenständigen
Tabellen auf einem Tabellenblatt.
Hier ist das Makro.

Sub Jahresrestverbrauch()
'
' Jahresrestverbrauch Makro
' Makro am 09.03.2009 aufgezeichnet
'

'
Range("AS81:AT95").Select
Application.CutCopyMode = False
Selection.Copy
Range("AV81").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("AP81:AQ95").Select
Application.CutCopyMode = False
Selection.Copy
Range("AS81").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("AM81:AN95").Select
Application.CutCopyMode = False
Selection.Copy
Range("AP81").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("AJ81:AK95").Select
Application.CutCopyMode = False
Selection.Copy
Range("AM81").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("AN81"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Selection.Copy
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
Range("K81").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Sort Key1:=Range("L81"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 35
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 42
ActiveWindow.ScrollColumn = 43
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 45
Range("AY81:AZ95").Select
Selection.Copy
Range("BB81").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("BC81"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("BG81:BH95").Select
Selection.Copy
Range("BJ81").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("BK81"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("BM81:BN95").Select
Selection.Copy
Range("BP81").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("BQ81"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveWindow.ScrollColumn = 46
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 49
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 51
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 58
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 60
ActiveWindow.ScrollColumn = 61
ActiveWindow.ScrollColumn = 62
ActiveWindow.ScrollColumn = 63
ActiveWindow.ScrollColumn = 64
Range("BS81:BT95").Select
Selection.Copy
Range("BV81").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("BW81"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("BY81:BZ95").Select
Selection.Copy
Range("CB81").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("CC81"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveWindow.ScrollColumn = 63
ActiveWindow.ScrollColumn = 62
ActiveWindow.ScrollColumn = 61
ActiveWindow.ScrollColumn = 60
ActiveWindow.ScrollColumn = 59
ActiveWindow.ScrollColumn = 58
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 55
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 51
ActiveWindow.ScrollColumn = 50
ActiveWindow.ScrollColumn = 49
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 46
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 44
Range("BJ81:BK95").Select
Selection.Copy
ActiveWindow.ScrollColumn = 43
ActiveWindow.ScrollColumn = 42
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 40
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 38
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 36
ActiveWindow.ScrollColumn = 35
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 33
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
Range("O81").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
End Sub

Claus Busch

unread,
Jul 6, 2009, 10:20:45 AM7/6/09
to

Hallo Ernst,

Am Mon, 6 Jul 2009 06:55:01 -0700 schrieb ernsthj:

> Es handelt sich bei dem Makro um mehrere Sortierungen in eigenst�ndigen

> Tabellen auf einem Tabellenblatt.
> Hier ist das Makro.

[Code ausgeschnitten]

du solltest deinen Code mal von den ganzen unn�tigen Dingen bereinigen,
z.B. die aufgezeichneten Scrollrows usw. und dann einmal sauber
referenzieren.
Der Anfang deines Codes k�nnte z.B. einfach so aussehen:

Sub Jahresrestverbrauch()

Dim i As Integer

For i = 1 To Sheets.Count
With Sheets(i)
.Range("AS81:AT95").Copy
.Range("AV81").PasteSpecial Paste:=xlPasteValues

.Range("AP81:AQ95").Copy
.Range("AS81").PasteSpecial Paste:=xlPasteValues

.Range("AM81:AN95").Copy
.Range("AP81").PasteSpecial Paste:=xlPasteValues

.Range("AJ81:AK95").Copy
.Range("AM81").PasteSpecial Paste:=xlPasteValues
End With
Next
End Sub


Mit freundlichen Gr�ssen

0 new messages