VBA Code

[Steffl]

Hallo Markus,

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")
   vntZiel = Array("Q", "R", "T", "AA", "AB", "AC", "W", "X", "Y", "N", "O", "B", "C", "AO")
  
   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
         rngZelle.Offset(, 6).Copy Worksheets("Spielabschnitt").Range("H2" & Range("M2"))
      Exit For
      End If
   Next rngZelle
  
   Application.CutCopyMode = False
  
End Sub

[Maximus]

das ist gut, mappe vernichten und dann neu anfangen.
würde dann bei mir dann auch nicht besser aussehen.

dieser Zusatz:
Wenn in AA6 eine Null dann soll KEINE Copy stattfinden!

ich denke dieser zusatz würde reichen, dann müsste es gehen, weil ja dann nur ein einziger Übertrag stattfindet, alle anderen überträge würden gehindert, weil die Zellen mit der Null einen Übertrag verhindern würde.

[Maximus]

gestrichen

[Maximus]

Hallo Markus,

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")
  vntZiel = Array("Q", "R", "T", "AA", "AB", "AC", "W", "X", "Y", "N", "O", "B", "C", "AO")
 
  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
        rngZelle.Offset(, 6).Copy Worksheets("Spielabschnitt").Range("H2" & Range("M2"))
     Exit For
     End If
  Next rngZelle
 
  Application.CutCopyMode = False
 
End Sub

Hi Stefan, danke läuft ruckelfrei.

es werden aber noch nicht die Werte von:
AG9, AG12, AG15, AG23, AG26, AG29, AG32, AG40, AG43, AG46, AG49

nach H übertragen

Gruss

[Steffl]

Hallo Markus,

sorry, war ein Fehler drin.

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")
   vntZiel = Array("Q", "R", "T", "AA", "AB", "AC", "W", "X", "Y", "N", "O", "B", "C", "AO")

   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

[Maximus]

Hallo Stefan,
wahnsinn, absolut perfekt umgesetzt. Jetzt wird tatsächlich immer nur ein Eintrag übertragen, auch wenn ich nicht nachvollziehen kann, warum das so ist, weil AG6, AG9, AG12... von dir namentlich im Programm gar nicht genannt worden sind. Aber funzt einwndfrei.

Der einzige Unterschied zum alten Programm ist, dass jetzt nach Betätigen des Button:"nach Spielabschnitt kopieren", ich mich weiterhin in der Kopie befinde.
Beim alten Programm bin ich nach betätigen des Buton:"nach Spielabschnitt kopieren" gleich im Spielabschnitt gewesen und konnte dort handschriftlich noch Änderung vornehmen.
Ich glaube das liegt an Zelle AR1 und AR2 im Arbeitsblatt Spielabschnitt, weil dort der einzige sichtbare Unterschied ist, wenn dorthin Überträge stattfinden.
Aber das stört mich jetzt nicht so.
Hauptsache der Übertrag von AG6 ff. nach H klappt jetzt.


Nochmals vielen, vielen DANK!!!!Super Leistung! Hätte ich nie hinbekommen!
Und der Übertrag läuft durch deine Kürzung des Programmes viel viel flüssiger!!!!

Gruß Markus

[Steffl]

Hallo Markus,

....auch wenn ich nicht nachvollziehen kann, warum das so ist, weil AG6, AG9, AG12... von dir namentlich im Programm gar nicht genannt worden sind. Aber funzt einwndfrei.

Du hattest im Thread geschrieben, dass in Spalte AA entweder eine 1 oder 0 steht und je nach Wert soll die Spalte AG kopiert werden oder nicht und da war es für mich leichter mich nach der Spalte AA zu richten. Auf die Spalte AG greife mit dem Versatz zu (.Offset) 6 Spalten rechts von AA liegt AG.

Der einzige Unterschied zum alten Programm ist, dass jetzt nach Betätigen des Button:"nach Spielabschnitt kopieren", ich mich weiterhin in der Kopie befinde.
Beim alten Programm bin ich nach betätigen des Buton:"nach Spielabschnitt kopieren" gleich im Spielabschnitt gewesen und konnte dort handschriftlich noch Änderung vornehmen.
Ich glaube das liegt an Zelle AR1 und AR2 im Arbeitsblatt Spielabschnitt, weil dort der einzige sichtbare Unterschied ist, wenn dorthin Überträge stattfinden.

Nein. Das liegt daran das in meinen Code keine Selektierung bzw. Aktivierung von Tabellenblättern stattfindet. Wenn Du den Sprung zum Tabellenblatt Spielabschnitt unbedingt haben willst dann füge vor dem End Sub folgende Codezeile ein.

Code:

Worksheets("Spielabschnitt").Activate

[Maximus]

Hi Stefan,
vielen DANK!
Das klappt super mit dem Zusatz!!! Jetzt läuft alles fast perfekt.
Ein Unterschied zum alten Vordruck ist mir noch aufgefallen.

In den Kopien (Kopie1,  Kopie2, Kopie3.....) wird in M1 und M2 über eine Zellenformel ein Eintrag angezeigt.

Beim "nach Spielabschnit kopieren" wird in AR1 und AR2 die Formel von M1 und M2 kopiert, aber schön wäre es wenn der Wert von M1 und M2 kopiert wird.
Das war im alten Vordruck der Fall. Weisst du woran das liegt?

Gruß Markus

[Steffl]

Hallo Markus,

mache es so

Code:

Worksheets("Spielabschnitt").Range("AR1:AR2").Value = Range("M1:M2").Value

[Maximus]

HALLO Stefan!

Ich habe bestimmt 2-3Stunden Änderungen vorgenommen, aber es hat einfach nicht geklappt!
Ich hätte das jetzt so gelassen!

Mit deiner Änderung funktioniert es auf Anhieb! Super, bin begeistert! Klasse gemacht!

Vielleicht kannst du mir noch eine Frage beantworten:

Wenn ich im Tabellenblatt "Spielvordruck" bin, dann ist das Steuerelement "nach Spielabschnitt kopieren" NICHT zu sehen.
Wenn ich aber über das Steuerelement "neue Kopie" eine Kopie erzeuge, dann ist in der Kopie das Steuerelement "nach Spielabschnitt kopieren" zu sehen.
Aber es wird doch ein Duplikat erstellt, dann müßte man das Steuerelement doch schon im Tabellenblatt " Spielvordruck" sehen.
Weisst du wie der Erfinder das gemacht hat? Da Grübel ich auch schon ziemlich lange drüber nach, aber finde keine Erklärung.

Gruss Markus