Document opslaan als weeknummer ...(+1)`

[Morriss]

Goedemorgen,

Ik heb een macro in een document dat opgeslagen is als staat week 51.xlsm Nu wil ik graag dat de macro het document opslaat en vervolgens het document opslaat als (save as) een week later, dus staat week 52. Elke keer als ik de macro start moet ie het document dus opslaan en een nieuw document creeeren (met dezelfde naam maar dan 1 week later).

Ook dient cel F11 van 51 naar 52 te gaan (daar staat het weeknummer in weergegeven), maar dat lijkt me eenvoudiger op te lossen dan voorgaande vraag.

Dat ik hem over 2 weken één keer handmatig als week 1 moet opslaan is geen probleem.

Alvast bedankt voor de moeite!!

Met vriendelijke groet,

Sub Opslaan2()
'
' Opslaan2 Macro
'

'
    ActiveWorkbook.Save
    ActiveWorkbook.SaveAs Filename:= _
        "\\Home\ staat week 52.xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Range("K15:K129").Select
    Selection.Copy
    Range("O15").Select
    ActiveSheet.Paste
    Range("K15:K129").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("F11").Select
    ActiveCell.FormulaR1C1 = "52"
    Range("H19").Select
End Sub

 

[koster1984]

Ik heb wat voor je gemaakt, kijk eens of dit voor je werkt (hij gaat trouwens ook automatisch van week 53 naar week 1):

Sub Opslaan2()
Dim wknr As Variant
wknr = Right(Replace(ThisWorkbook.Name, ".xlsm", ""), 2)
    ActiveWorkbook.Save
    ActiveWorkbook.SaveAs ThisWorkbook.Path & IIf(wknr = 53, "\staat week 1", "\staat week " & wknr + 1 & ".xlsm")
    Range("K15:K129").Copy
    Range("O15").PasteSpecial
    Range("K15:K129").ClearContents
    Application.CutCopyMode = False
    Range("F11") = IIf(wknr = 53, 1, wknr + 1)
    Range("H19").Select
    ActiveWorkbook.Save
End Sub

 

[Morriss]

Bedankt voor je reactie Koster 1984! Dit lijkt zeker te werken, echter zou ik graag wat dingen aanpassen:

- de bestandsnaam
- de locatie (path) waar het document staat

Ik heb deze regel geprobeerd te wijzigen, maar dan werkt de macro niet goed meer.

ActiveWorkbook.SaveAs ThisWorkbook.Path & IIf(wknr = 53, "\staat week 1", "\staat week " & wknr + 1 & ".xlsm")

 

[koster1984]

Waarin wil je het wijzigen?

 

[Morriss]

Uhm, bestandsnaam wijzigen in: productieopname staat week 51

locatie/path: \\test\test1\productieopname

Die "test" vervang ik dan zelf voor de goede locatie. Ik zou graag zelf weten hoe ik het aan moet passen.

Bedankt voor de moeite!!!

 

[koster1984]

De rode stukjes heb ik aangepast:

Sub Opslaan2()
Dim wknr As Variant
wknr = Right(Replace(ThisWorkbook.Name, ".xlsm", ""), 2)
    ActiveWorkbook.Save
    ActiveWorkbook.SaveAs [COLOR="#FF0000"]"\\test\test1\productieopname"[/COLOR] & IIf(wknr = 53, "[COLOR="#FF0000"]\productieopname [/COLOR]staat week 1", "\[COLOR="#FF0000"]productieopname [/COLOR]staat week " & wknr + 1 & ".xlsm")
    Range("K15:K129").Copy
    Range("O15").PasteSpecial
    Range("K15:K129").ClearContents
    Application.CutCopyMode = False
    Range("F11") = IIf(wknr = 53, 1, wknr + 1)
    Range("H19").Select
    ActiveWorkbook.Save
End Sub

Zodoende wordt de bestandsnaam (incl. adres) bijvoorbeeld: \\test\test1\productieopname\productieopname staat week 52 (let wel op dat de mappen ook echt dienen te bestaan)

 

[Morriss]

Helemaal super! dankjewel! werkt goed!

Stel dat ik nou op blad 1 en op blad 2 (dus op meerdere sheets) die cellen +1 wil doen en wil kopieren? Hoe kan ik dat dan makkelijk in die macro zetten?

 

[koster1984]

Als volgt:

Sub Opslaan2()
Dim wknr As Variant[COLOR="#FF0000"], sht As Long[/COLOR]
wknr = Right(Replace(ThisWorkbook.Name, ".xlsm", ""), 2)
    ActiveWorkbook.Save
    ActiveWorkbook.SaveAs "\\test\test1\productieopname" & IIf(wknr = 53, "\productieopname staat week 1", "\productieopname staat week " & wknr + 1 & ".xlsm")
    [COLOR="#FF0000"]For sht = 1 To 2[/COLOR]
        [COLOR="#FF0000"]With Sheets(sht)[/COLOR]
            [COLOR="#FF0000"].[/COLOR]Range("K15:K129").Copy
            [COLOR="#FF0000"].[/COLOR]Range("O15").PasteSpecial
            [COLOR="#FF0000"].[/COLOR]Range("K15:K129").ClearContents
            Application.CutCopyMode = False
            [COLOR="#FF0000"].[/COLOR]Range("F11") = IIf(wknr = 53, 1, wknr + 1)
            [COLOR="#FF0000"].[/COLOR]Range("H19").Select
        [COLOR="#FF0000"]End With[/COLOR]
    [COLOR="#FF0000"]Next sht[/COLOR]
    ActiveWorkbook.Save
End Sub

 

[Morriss]

Helemaal goed! Hartelijk bedankt voor de hulp! OPGELOST!

 

[koster1984]

o die H19.select heeft alleen eerst een sheets.select nodig:

Sub Opslaan2()
Dim wknr As Variant, sht As Long
wknr = Right(Replace(ThisWorkbook.Name, ".xlsm", ""), 2)
    ActiveWorkbook.Save
    ActiveWorkbook.SaveAs ThisWorkbook.Path & IIf(wknr = 53, "\productieopname staat week 1", "\productieopname staat week " & wknr + 1 & ".xlsm")
    For sht = 1 To 2
        With Sheets(sht)
            .Range("K15:K129").Copy
            .Range("O15").PasteSpecial
            .Range("K15:K129").ClearContents
            Application.CutCopyMode = False
            .Range("F11") = IIf(wknr = 53, 1, wknr + 1)
            Sheets(sht).Select
            Range("H19").Select
        End With
    Next sht
    ActiveWorkbook.Save
End Sub