2 VBA-Codes gleichzeitig ausführen

[Maximus]

Hi,

ich habe ein VBA-Code in einem Modul gespeichert, welches durch Betätigung eines Button ausgeführt wird.

Jetzt habe ich einen zweiten VBA Code darunter geschrieben.

Ich würde gerne, dass durch Betätigung des Button gleich beide Codes abgespielt werden, was zur Zeit nicht geschieht.

Was muss ich ändern?

Viele Grüße und DANKE!

Code:

Sub kopieren()
  Dim lngC As Long
  Dim rngZelle As Range
  Dim vntUrsprung As Variant, vntZiel As Variant
 
  vntUrsprung = Array("B23", "E23", "G10", "G28", "G35", "C45", "L29", "M29", "N29", "P29", "Q29", "P14", "Q14", "Q10", "G38")
  vntZiel = Array("Q", "R", "T", "AA", "AB", "AC", "W", "X", "Y", "N", "O", "B", "C", "AO", "AI")

  Range("M1:M2").Copy Worksheets("Spielabschnitt").Range("AR1")

  For lngC = 0 To UBound(vntUrsprung)
     Worksheets("Spielabschnitt").Range(vntZiel(lngC) & Range("M2")).Value = Range(vntUrsprung(lngC)).Value
  Next lngC
 
  For Each rngZelle In Range("AA6,AA9,AA12,AA15,AA23,AA26,AA29,AA32,AA40,AA43,AA46,AA49")
     If rngZelle.Value = 1 Then
        Worksheets("Spielabschnitt").Range("H" & Range("M2")).Value = rngZelle.Offset(, 6).Value
        Exit For
     End If
  Next rngZelle
 
  Application.CutCopyMode = False
 
End Sub



Sub FarbeReiter()
Dim Blatt As Worksheet

For Each Blatt In ActiveWorkbook.Worksheets

If InStr(Blatt.Name, "Kopie") > 0 Then
Blatt.Tab.ColorIndex = 3
End If

Next Blatt
End Sub

[Gast 123]

Hallo

die Frage ist rasch und einfach erklaert.  Es gibt zwei Möglichkeiten.  Einen dritten Code, s. unten
Oder im vorhanden Code  vor End Sub  mit Call ReiterFarbe Oder Call Kopieren den anderen Code starten.
Wohlgemerkt immer den anderen Code:  nicht den eigenen Code im eigenen Code aufrufen!!  (=> endlose Todesschleife!!)

mfg  Gast 123 

Code:

'Button diesen Code zuweisen
Sub Button_BeiKlick()
  Call Kopieren
  Call ReiterFarbe
End Sub

[Maximus]

Hi Gast,
danke für deine Antwort.
Habe deinen Code als dritten Code hinzugefügt.
Irgendwas mach ich noch falsch, weil es noch nicht funktioniert, wenn ich auf den Button drücke. Muß ich irgendwie den dritten code über Makro zuweisen integrieren?

hier die drei codes wie sie bei mir im Modul2 stehen:

Danke und Gruss

Code:

Sub kopieren()
  Dim lngC As Long
  Dim rngZelle As Range
  Dim vntUrsprung As Variant, vntZiel As Variant
 
  vntUrsprung = Array("B23", "E23", "G10", "G28", "G35", "C45", "L29", "M29", "N29", "P29", "Q29", "P14", "Q14", "Q10", "G38")
  vntZiel = Array("Q", "R", "T", "AA", "AB", "AC", "W", "X", "Y", "N", "O", "B", "C", "AO", "AI")

  Range("M1:M2").Copy Worksheets("Spielabschnitt").Range("AR1")

  For lngC = 0 To UBound(vntUrsprung)
     Worksheets("Spielabschnitt").Range(vntZiel(lngC) & Range("M2")).Value = Range(vntUrsprung(lngC)).Value
  Next lngC
 
  For Each rngZelle In Range("AA6,AA9,AA12,AA15,AA23,AA26,AA29,AA32,AA40,AA43,AA46,AA49")
     If rngZelle.Value = 1 Then
        Worksheets("Spielabschnitt").Range("H" & Range("M2")).Value = rngZelle.Offset(, 6).Value
        Exit For
     End If
  Next rngZelle
 
  Application.CutCopyMode = False
 
End Sub

Sub FarbeReiter()
Dim Blatt As Worksheet

For Each Blatt In ActiveWorkbook.Worksheets

If InStr(Blatt.Name, "Kopie") > 0 Then
Blatt.Tab.ColorIndex = 3
End If

Next Blatt
End Sub

'Button diesen Code zuweisen
Sub Button_BeiKlick()
 Call kopieren
 Call ReiterFarbe
End Sub

[Maximus]

Im Modul1 habe ich die deinen code auch mal versucht reinzupacken und zu starten.
Geht aber irgenwie auch nicht.
Hier habe ich call kopieren in call Kopie geändert.
siehe hier der code:

Code:

Sub Kopie()
   Dim wks As Worksheet
On Error Resume Next
'ActiveSheet.Copy after:=Worksheets(Worksheets.Count)

  ActiveSheet.Copy after:=Worksheets(Worksheets.Count)
  Sheets(Sheets.Count).Name = "Kopie" & Sheets.Count - 2
  With Worksheets("Kopie" & Sheets.Count - 3)
   .Range("F45").Copy
    Range("A45").PasteSpecial Paste:=xlPasteValues
   .Range("E28").Copy
    Range("B28").PasteSpecial Paste:=xlPasteValues
    Range("C8").PasteSpecial Paste:=xlPasteValues
   .Range("G38").Copy
    Range("G33").PasteSpecial Paste:=xlPasteValues
    If Range("G33").Value > 0 Then
  Range("G33").Value = 0
End If
   .Range("K29").Copy
    Range("A10").PasteSpecial Paste:=xlPasteValues
 
 
  ActiveSheet.Buttons.Add(868.5, 232.5, 76.5, 34.5).Select
   Selection.OnAction = "kopieren"
   Selection.Characters.Text = "nach Spielabschnitt kopieren"
   ActiveSheet.Shapes("Button 1").ScaleHeight 1.7156877175, msoFalse, _
       msoScaleFromTopLeft
   ActiveSheet.Shapes("Button 1").ScaleHeight 1.0114284583, msoFalse, _
       msoScaleFromTopLeft
       
   Range("M21").Select
   Range("L1").Select
   
  Application.CutCopyMode = False
 
End With
End Sub

Sub FarbeReiter()
Dim Blatt As Worksheet

For Each Blatt In ActiveWorkbook.Worksheets

If InStr(Blatt.Name, "Kopie") > 0 Then
Blatt.Tab.ColorIndex = 3
End If

Next Blatt
End Sub

'Button diesen Code zuweisen
Sub Button_BeiKlick()
 Call Kopie
 Call ReiterFarbe
End Sub

[Kuwer]

Hallo,

wenn das eine Makro FarbeReiter heißt, muss es auch mit diesem Namen aufgerufen werden.  

Gruß Uwe

[Maximus]

wenn ich bei mir auf einen button gehe und auf Makro zuweisen habe  ich drei VBA-Codes stehen:
FarbeReiter
Kopie
kopieren

Für mich hatte jdm. mal 2 Button erstellt und jedem Button einen Code zugeordnet.
Bei dem einen Button ist der VBA Code Kopie hinterlegt.
Beim anderen Butoon der Code kopieren.

Wenn ich auf einen der Button gehe und Makro zuweisen kann ich nicht erkennen welcher Code von den dreien zugeordnet ist. Es stehen alle drei Codes da!
Ich habe ja den dritten code FarbeReiter im nachhinein in Modul2 hinzugefügt, somit erscheint dieser code bei makro zuweisen jetzt auch.
wenn ich manuell auf diesen code unter makro zuweisen gehe und auf ok klicke und dann auf den button funktioniert er.
Somit weiß ich schon mal dass der dritte code auch funktioniert.
Aber wie gesagt für mich ist nicht zu erkenn unter Makro zuweisen, welcher codegerade gespeichert ist

[BoskoBiati]

Hi,

warum dann nicht aus zwei Codes einen machen?

[Steffl]

Hallo Markus,

Wenn ich auf einen der Button gehe und Makro zuweisen kann ich nicht erkennen welcher Code von den dreien zugeordnet ist. Es stehen alle drei Codes da!

kann ich nicht nachvollziehen. Der zugewiesene Code steht doch unter Makroname.

[PhilippB]

Bau dir ein dritte Sub und lege die reinfolge fest. Bei mir geht das so ziemlich gut

Sub Main()

Call convertCSV
Call zusammenfassen
Call MakroVBA_NL
Call VBA_KST
Call Aufbau_Abbau
Call NL_Zuordnung
Call Sheet4
Call AktivMaster

MsgBox "Fertig"

End Sub

[BoskoBiati]

Hi,

alles in einem Makro:

Code:

Sub kopieren()
  Dim lngC As Long
  Dim rngZelle As Range
  Dim vntUrsprung As Variant, vntZiel As Variant
Dim Blatt As Worksheet

  vntUrsprung = Array("B23", "E23", "G10", "G28", "G35", "C45", "L29", "M29", "N29", "P29", "Q29", "P14", "Q14", "Q10", "G38")
  vntZiel = Array("Q", "R", "T", "AA", "AB", "AC", "W", "X", "Y", "N", "O", "B", "C", "AO", "AI")

  Range("M1:M2").Copy Worksheets("Spielabschnitt").Range("AR1")

  For lngC = 0 To UBound(vntUrsprung)
     Worksheets("Spielabschnitt").Range(vntZiel(lngC) & Range("M2")).Value = Range(vntUrsprung(lngC)).Value
  Next lngC

  For Each rngZelle In Range("AA6,AA9,AA12,AA15,AA23,AA26,AA29,AA32,AA40,AA43,AA46,AA49")
     If rngZelle.Value = 1 Then
        Worksheets("Spielabschnitt").Range("H" & Range("M2")).Value = rngZelle.Offset(, 6).Value
        Exit For
     End If
  Next rngZelle

  Application.CutCopyMode = False
For Each Blatt In ActiveWorkbook.Worksheets

If InStr(Blatt.Name, "Kopie") > 0 Then
Blatt.Tab.ColorIndex = 3
End If

Next Blatt
End Sub