VBA-Code Änderung möglich?

[Maximus]

Hallo VBA-Experten,

habe zur Zeit folgendes Problem:
Mit dem unten aufgeführten VBA-Programm, welches sich in einem Modul befindet, bin ich in der Lage, automatisch ein neues Tabellenblatt zu erzeugen.
Dabei werden immer bestimmte Daten vom zuletzt erzeugten Tabellenblatt ins neue Tabellenbblatt übertragen.
Z.B werden vom zuletzt erzeugten Tabellenblatt Werte aus F45 in A45 des neuen Tabellenblatt übernommen.
Funktioniert fehlerfrei!
Ich würde gerne eine Änderung in dem Programm haben:
Beim Übertrag von G38 in G33 soll folgende zusätzliche Bedingung vorliegen:
Es sollen nur Minuswerte und Null übernommen werden. Wenn Wert größer als Null, dann soll der Wert immer Null sein.


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
    .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





Kann man da was machen?

Danke und Gruß Markus

[Ego]

Hallo maximus,

hinter deine markierten Zeilen:

If Range("G33").Value > 0 Then
   Range("G33").Value =0
End If

[RPP63]

Moin!
Ich hole mal gerade meine Glaskugel heraus, Markus.
Handelt es sich um Monatsblätter und Dein Makro sorgt für einen korrekten Übertrag des Endbestandes?

Dann solltest Du in Erwägung ziehen, Dein Konzept zu überdenken.
Alles in ein Blatt und die Monatsauswertung(en) erstellst Du mit dem AutoFilter iVm Teilergebnis() und/oder mit einem Pivot-Table.

Gruß Ralf

[Maximus]

Hi Helmut,
super danke funktioniert!!!!

Viele Grüße

[Maximus]

Moin Ralf,
ist nur ein Vordruck für Fußballwetten/Casino.
Aber ich werde die beiden Begriffe von dir mal googlen und mir darüber ein Kopf machen.
Danke!!