Makro ergänzen

Forumthread: Makro ergänzen

Makro ergänzen

21.02.2020 14:09:30

mike49

Hallo Leute,
welche Zeile muss ich im Makro einfügen, damit auch die Jahreszahl in C1 um 1 Jahr ehöht wird.

Sub WerteUebertragen()
Application.ScreenUpdating = False
Dim var
var = MsgBox("M ö c h t e n  S i e  s t a r t e n?", vbYesNo, "Nachfrage")
ActiveSheet.Unprotect
If var = 6 Then
Range("C6:C8").Select
Selection.Copy
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C10:C11").Select
Application.CutCopyMode = False
Selection.Copy
Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C16:C17").Select
Application.CutCopyMode = False
Selection.Copy
Range("B16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C19").Select
Application.CutCopyMode = False
Selection.Copy
Range("B19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=12
Range("C24:C26").Select
Application.CutCopyMode = False
Selection.Copy
Range("B24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C31").Select
Application.CutCopyMode = False
Selection.Copy
Range("B31").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-27
Range("C6:C8,C10:C11,C16:C17,C19,C24:C26,C31").Select
Range("C31").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("B37,B40,B42,B45,B47").Select
Selection.ClearContents
Range("C37,C40,C42,C45,C47").Select
Selection.ClearContents
Range("B1").Select
ActiveSheet.Protect
Application.ScreenUpdating = True
End If
End Sub

Gruß
mike49

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro ergänzen

21.02.2020 14:20:02

UweD
Klappt prima . . .

21.02.2020 14:43:18

mike49
Danke für die Rückmeldung. owT

21.02.2020 14:56:08

UweD
Upps! Ich war zu voreilig . . .

21.02.2020 15:33:09

mike49
AW: Upps! Ich war zu voreilig . . .

21.02.2020 15:52:47

UweD
AW: Upps! Ich war zu voreilig . . .

21.02.2020 16:07:10

mike49
Ja genau . . .

21.02.2020 16:27:17

mike49

AW: Makro ergänzen

21.02.2020 14:20:02

UweD

Hallo
auf select kann in 99% verzichtet werden
Dein Code könnte so aussehen.

Sub WerteUebertragen()
    Application.ScreenUpdating = False
    Dim var
    var = MsgBox("M ö c h t e n  S i e  s t a r t e n?", vbYesNo, "Nachfrage")
    ActiveSheet.Unprotect
    If var = 6 Then
         Range("B6:B8") = Range("C6:C8")
         Range("B10:B11") = Range("C10:C11")
         Range("B16:B17") = Range("C16:C17")
         Range("B19") = Range("C19")
         Range("B24:B26") = Range("C24:C26")
         Range("B31") = Range("C31")
         
         Range("C6:C8,C10:C11,C16:C17,C19,C24:C26,C31").ClearContents
         Range("B37,B40,B42,B45,B47").ClearContents
         Range("C37,C40,C42,C45,C47").ClearContents
         
         Range("B1").Select
         
         
         'Neu 
         Range("C1") = Range("C1") + 1
         
         
         ActiveSheet.Protect
     End If
End Sub

LG UweD

Klappt prima . . .

21.02.2020 14:43:18

mike49

Danke UweD
LG
mike49

Danke für die Rückmeldung. owT

21.02.2020 14:56:08

UweD

Upps! Ich war zu voreilig . . .

21.02.2020 15:33:09

mike49

. . . ich musste die Tabelle noch erweitern und jetzt klappt's nicht.
Kannst du dir's mal anschauen? Ich lade die Datei hoch:
https://www.herber.de/bbs/user/135362.xlsm
LG
mike49

AW: Upps! Ich war zu voreilig . . .

21.02.2020 15:52:47

UweD

Hallo
.value ergänzt
B40 und C40 sowie
B42 und C42 waren verbundene Zellen, das gibt einen Fehler.
Ich denke, du meinst aber die Zeilen 41 und 43 ebenso 46 und 48

Sub WerteUebertragen()
    Application.ScreenUpdating = False
    Dim var
    var = MsgBox("M ö c h t e n  S i e  s t a r t e n?", vbYesNo, "Nachfrage")
    ActiveSheet.Unprotect
    If var = 6 Then
         Range("B6:B8") = Range("C6:C8").Value
         Range("B10:B11") = Range("C10:C11").Value
         Range("B16:B17") = Range("C16:C17").Value
         Range("B19") = Range("C19").Value
         Range("B24:B26") = Range("C24:C26").Value
         Range("B31") = Range("C31").Value
         
         Range("C6:C8,C10:C11,C16:C17,C19,C24:C26,C31").ClearContents
         Range("B37,B41,B43,B46,B48").ClearContents
         Range("C37,C41,C43,C46,C48").ClearContents
         
         Range("B1").Select
         Range("C1") = Range("C1") + 1
         ActiveSheet.Protect
     End If
End Sub

LG UweD

AW: Upps! Ich war zu voreilig . . .

21.02.2020 16:07:10

mike49

Hallo UweD,
schön, dass du dich nochmals meldest.
Ich habe im Prinzip die Zeile 37 (Datum:) eingefügt.
Es sollen also auch die Werte aus den Zellen C37,C38,C41,C43,C46 und C48 übertragen werden, wenn Werte drinstehen.
Gruß
mike49

Ja genau . . .

21.02.2020 16:27:17

mike49

. . . so ist's richtig.
Jetzt klapp's wie gewollt!
Danke vielmals für deine Hilfe.
Gruß
mike49

Beliebteste Forumthreads (12 Monate)

Forumthread: Makro ergänzen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread