Excel 2007 VBA - Makro aus Modul soll mit Button in allen Tabellenblätter starten

Question

Hallo zusammen,

ich suche gerade eine (einfache) Lösung um Makros aus einem Modul zu starten.

Hier eine kurze Zusammenfassung:

Ich habe eine Mappe mit mehreren Tabellenblättern. Nun habe ich ein Makro in Modul1 mit Namen "Start". Dieses möchte ich mit einem Button ausführen. Soweit so gut.

Jetzt habe ich allerdings noch 3 andere Makros. Diese sollen ebenfalls mit dem gleichen Button ausgeführt werden und sollen aber alle Tabellenblättern durchlaufen und dort z.B. Summen bilden, den Druckbereich festlegen, etc., soblad das Makro "Start" abgeschlossen ist. Diese habe ich das Modul 2 gepakt.

Ich habe es mit folgendem Makro versucht (Steht in "Diese Arbeitsmappe")

Private Sub CommandButton1_Click()
Call Modul1.Start
Dim wks As Worksheet
For Each sh In ActiveWorkbook.Worksheets
Next

Call Modul2.Summe
Call Modul2.x
Call Modul2.Druckbereich
End Sub

Leider klappt es nicht, da zwar das Makro "Start" funktioniert, aber alle anderen Makros nichts machen.

Kann mir hier bitte jemand helfen? Danke schon im Voraus.

Gruß
Florian

Answer 1

Hi Florian,

die Prozedur Private Sub CommandButton1_Click() gehört ins Codemodul des Tabellenblattes, auf dem sich der CommandButton befindet - nicht unter DieseArbeitsmappe.

Private Sub CommandButton1_Click()
Start
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
Summe
Makro_x
Druckbereich
Next
End Sub

Call kannst du weglassen - ist nicht erforderlich, schadet aber auch nicht. Modul-Name kannst du weglassen, da alles in der selben Arbeitsmappe abläuft.

Bis später,
Karin

Answer 2

Hallo Karin,

vielen Dank für deine Antwort.

Ich weiß nicht warum, aber es funktioniert leider nicht.

Tabelle

Ich hab mal vorsichtshalber die Tabelle angehängt. Vielleicht hat sich wo anders der Fehlerteufel eingeschlichen.

Danke

Gruß
Florian

Answer 3

Hi Florian,

du verwendest immer ActiveSheet - der Code bezieht sich also tatsächlich immer auf das Tabellenblatt "Einzelwerte". Der einfachste Weg - übergib an die Unterprozeduren noch das jeweilige Tabellenblatt und beziehe dich dann auf dieses Tabellenblatt.
Du kannst alle Unterprozeduren in das selbe Modul schreiben, da die Codezeilen eine bestimmte Anzahl nicht überschreiten (es müssten schon seeeeehr viel mehr Zeilen sein, bevor du mehrere Module verwenden musst).

Der Code für den CommandButton müsste so heißen:

Private Sub CommandButton1_Click()
Dim wks As Worksheet
Start
For Each wks In ActiveWorkbook.Worksheets
Summe wks ' Unterprozedur starten und mit betreffender Tabelle
x wks ' Unterprozedur starten und mit betreffender Tabelle
Druckbereich wks ' Unterprozedur starten und mit betreffender Tabelle
Next
End Sub

Und im Modul dann dieser Code:

Sub Start()
Dim lngLetzte As Long
Dim lngZeile As Long

If ThisWorkbook.Sheets("Einzelwerte").FilterMode Then ThisWorkbook.Sheets("Einzelwerte").ShowAllData
If ThisWorkbook.Sheets("KST-Matrix").FilterMode Then ThisWorkbook.Sheets("KST-Matrix").ShowAllData

With Worksheets("Diesel International DEU")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 4)), .Cells(.Rows.Count, 4).End(xlUp).Row, .Rows.Count) + 1
End With
With Worksheets("Einzelwerte")
For lngZeile = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) To 2 Step -1
If .Cells(lngZeile, 4) = "Hochleistungs-Diesel" And .Cells(lngZeile, 3) = "Deutschland" Or .Cells(lngZeile, 4) = "Diesel" And .Cells(lngZeile, 3) = "Deutschland" Then
.Range(.Cells(lngZeile, 1), .Cells(lngZeile, 22)).Cut Worksheets("Diesel International DEU").Cells(lngLetzte, 1)
.Rows(lngZeile).Delete
lngLetzte = lngLetzte + 1
End If
Next lngZeile
End With

With Worksheets("Diesel International Ausland")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 4)), .Cells(.Rows.Count, 4).End(xlUp).Row, .Rows.Count) + 1
End With
With Worksheets("Einzelwerte")
For lngZeile = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) To 2 Step -1
If .Cells(lngZeile, 4) = "Hochleistungs-Diesel" And .Cells(lngZeile, 3) <> "Deutschland" Or .Cells(lngZeile, 4) = "Diesel" And .Cells(lngZeile, 3) <> "Deutschland" Then
.Range(.Cells(lngZeile, 1), .Cells(lngZeile, 22)).Cut Worksheets("Diesel International Ausland").Cells(lngLetzte, 1)
.Rows(lngZeile).Delete
lngLetzte = lngLetzte + 1
End If
Next lngZeile
End With

With Worksheets("Andere Waren BRD")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 4)), .Cells(.Rows.Count, 4).End(xlUp).Row, .Rows.Count) + 1
End With
With Worksheets("Einzelwerte")
For lngZeile = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) To 2 Step -1
If .Cells(lngZeile, 4) <> "Hochleistungs-Diesel" And .Cells(lngZeile, 3) = "Deutschland" Or .Cells(lngZeile, 4) <> "Diesel" And .Cells(lngZeile, 3) = "Deutschland" Then
.Range(.Cells(lngZeile, 1), .Cells(lngZeile, 22)).Cut Worksheets("Andere Waren BRD").Cells(lngLetzte, 1)
.Rows(lngZeile).Delete
lngLetzte = lngLetzte + 1
End If
Next lngZeile
End With

With Worksheets("Andere Waren International")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 4)), .Cells(.Rows.Count, 4).End(xlUp).Row, .Rows.Count) + 1
End With
With Worksheets("Einzelwerte")
For lngZeile = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) To 2 Step -1
If .Cells(lngZeile, 4) <> "Hochleistungs-Diesel" And .Cells(lngZeile, 3) <> "Deutschland" Or .Cells(lngZeile, 4) <> "Diesel" And .Cells(lngZeile, 3) <> "Deutschland" Then
.Range(.Cells(lngZeile, 1), .Cells(lngZeile, 22)).Cut Worksheets("Andere Waren International").Cells(lngLetzte, 1)
.Rows(lngZeile).Delete
lngLetzte = lngLetzte + 1
End If
Next lngZeile
End With
End Sub

Sub x(wksTabelle As Worksheet)
With wksTabelle.Range("A3:M" & wksTabelle.Range("A200").End(xlUp).Row)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
End Sub

Sub Summe(wksTabelle As Worksheet)
Dim Loletzte As Long
With wksTabelle
MsgBox .Name
If .FilterMode Then .ShowAllData
Loletzte = .Cells(Rows.Count, 4).End(xlUp).Row + 2
.Cells(Loletzte, 1) = "Summe"
With .Cells(Loletzte, 6)
.FormulaLocal = "=Teilergebnis(9;F4:F" & .Row - 1 & ")"
.NumberFormat = "#,###.#0 €"
End With
With .Cells(Loletzte, 7)
.FormulaLocal = "=Teilergebnis(9;G4:G" & .Row - 1 & ")"
.NumberFormat = "#,###.#0 €"
End With
With .Cells(Loletzte, 9)
.FormulaLocal = "=Teilergebnis(9;I4:I" & .Row - 1 & ")"
.NumberFormat = "#,###.#0 €"
End With
With Union(.Cells(Loletzte, 1), .Cells(Loletzte, 6), .Cells(Loletzte, 7), .Cells(Loletzte, 9))
.Font.Bold = True
.Font.Name = "calibri"
.Font.Size = 11
End With
End With
End Sub

Sub Druckbereich(wksTabelle As Worksheet)
Dim Ende As Integer
With wksTabelle
Ende = .Cells(.Rows.Count, 1).End(xlUp).Row
With .PageSetup
.PrintArea = "$A$1:$O$" & Ende
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End With
End Sub

Den Codeteil für das Einblenden aller gefilterten Zeilen habe ich geändert - es geht auch ohne On Error Resume Next.
Wenn nur die Arbeitsmappe offen ist in der du den Code ausführst, kannst du noch ThisWorkbook weglassen.

Bis später,
Karin

Answer 4

Hallo Karin,

vielen, vielen Dank.

Jetzt funktionierts.

Noch eine "Schönheits"-Frage.

Wie müsste ich den Code noch verändern, wenn die letzte Linie unten eine Doppellinie sein soll?

Gruß

Florian

Answer 5

Hi Florian,

ändere diese Prozedur:

Sub x(wksTabelle As Worksheet)
With wksTabelle
With .Range("A3:M" & .Range("A200").End(xlUp).Row)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
.Range(.Cells(.Range("A200").End(xlUp).Row, 1), .Cells(.Range("A200").End(xlUp).Row, 13)).Borders(xlEdgeBottom).LineStyle = xlDouble
End With
End Sub

Bis später,
Karin

Answer 6

Klasse.

Danke schön.

Viele Grüße
Florian

Answer 7

Hallo Karin,

noch eine Frage zum tieferen Verständnis.

Wie müsste ich die Codes vom CommandButton1 anpassen, wenn ich z.B. nur einzelne Sheets ansprechen möchte und nicht alle.

Private Sub CommandButton1_Click()
Dim wks As Worksheet
Start
For Each wks In ActiveWorkbook.Worksheets
Summe wks ' Unterprozedur starten und mit betreffender Tabelle
x wks ' Unterprozedur starten und mit betreffender Tabelle
Druckbereich wks ' Unterprozedur starten und mit betreffender Tabelle
Next
End Sub

Danke

Gruß
Florian

Answer 8

Hi Florian,

dann musst du die betreffenden Tabellen noch per Name festlegen - so nach diesem Prinzip:

For Each wks In ActiveWorkbook.Worksheets
Select Case wks.Name
Case "A", "C", "Anton"
Summe wks ' Unterprozedur starten und mit betreffender Tabelle
x wks ' Unterprozedur starten und mit betreffender Tabelle
Druckbereich wks ' Unterprozedur starten und mit betreffender Tabelle
End Select
Next

Bis später,
Karin

Answer 9

Hallo Karin,

vielen Dank für die Info.

Man lernt einfach nie aus. Ich find's super, dass einem hier wirklich geholfen wird.

Einen schönen Tag noch

Florian