In plaats van datum , weeknummer overnemen

[davylenders123]

Ik heb een werkende macro.

Die het bestand opslaat met Als naam Dagrapport PC sortering gevolgd door datum die in Sheet data aanmaak staat in kolom a 1:53.
En in cel M3 van de eerste Sheet neemt hij deze datum ook telkens over
En het bestand wordt opgeslagen in de map bv 2018 12.

Nu zou ik deze graag aanpassen dat hij geen datum overneemt uit de Sheet Data Aanmaak maar een weeknummer die ik daar ingeef.
En hij moet nu niet opslaan in een map zoals 2018 12 , maar in de map Onderhoud.

Ik geraak er niet uit wat ik juist allemaal moet aanpassen.
Het rode (pad) heb ik reeds aangepast hoe het zou moeten volgens mij.
Enkel de datum geraak ik niet uit hoe ik deze in week nr moet wijzigen.

Sub Aanmaak_Blad_Ops_sortering()

For i = 1 To 53
  With Sheets("Data Aanmaak")
    pad = "G:\Pakketten\Mag-Data\Aanmaak Dagrapporten\aangemaakte\" & Format(CDate(.Cells(i, 1)), "yyyy mm") & "\Sortering\"
    [COLOR="#FF0000"]pad = "G:\Pakketten\Mag-Data\Aanmaak Dagrapporten\aangemaakte\Onderhoud\"[/COLOR]
    naam = "Dagrapport PC Sortering " & Format(CDate(.Cells(i, 1)), "dd-mm-yyyy") & ".xlsm"
    Range("M3").Value = Format(CDate(.Cells(i, 1)), dd - mm - yyyy)
  End With
  ActiveWorkbook.SaveAs pad & naam, 52
Next i

Bijlage een zo goed als leeg bestand om het te kunnen plaatsen , wat het hopelijk wat duidelijker maakt wat ik zou willen.
Bekijk bijlage Dagrapport PC Sortering.xlsm

 

[cow18]

eerst een aan SNB-ontleende UDF toevoegen en daarna die gebruiken om je weeknummer te bepalen

Public Function ISOweeknum(ByVal Datum As Date) As Integer
    ISOweeknum = DatePart("ww", Datum - Weekday(Datum, 2) + 4, 2, 2)
End Function

Sub test()
    naam = "Dagrapport PC Sortering " & ISOweeknum(Date) & ".xlsm" 'vervang date door je gewenste datum
    MsgBox naam
End Sub

 

[snb]

Vermijd spaties en tekens (m.u.v. underscores) in pad/bestandsnamen

Sub M_snb()
  activeworkbook.saveas "G:\Pakketten\MagData\Dagrapporten\Onderhoud\" & format(date,"yyyymm_") application.weeknum(date,21) & ".xlsx",52
End Sub

 

[cow18]

grappig, ik merk dat naast die weeknum met argument 21, nu ook de worksheetfunction isoweeknum zonder 2e argument bestaat.

 

[snb]

Dan heb jij blijkbaar MS gespekt (versie na 2010).

 

[cow18]

Tuurlijk, 'k heb een rechtstreekse lijn met Bill.

 

[davylenders123]

cow18 & snb
Alvast bedankt voor jullie snel reactie.

Ik geraak er niet echt wijzer uit.

Heb de eerste oplossing geprobeerd maar krijg enkel een msbox met daarin de benaming en de lopende week.
Verder gebeurt er niets.

De 2de oplossing zit een foutje in, verwacht : instrucie einde juist voor application.

Ik vermoed ook dat deze oplossingen niet zullen doen wat eigenlijk de bedoeling is , kan het fout hebben want ben niet echt goed met vba.
Maar probeer het nog even te verduidelijken.

In het vb bestand in Sheet Data Aanmaak staan in kolom A van 1 tem 53 nummers in (in vb van 1 tem 53 maar dit kan ook van 10 tem 53 zijn), bij de werkende macro waren dit datums.
Als ik de werkende macro uitvoerde werd het bestand x aantal maal opgeslagen op de gekozen locatie in de macro.
X aantal = Voor elke datum die in kolom A was ingeven werd het bestand opgeslagen als : bv in Sheet data aanmaak in cel A1 stond 01-01-2018 in A2 02/01/2018 enz dan kreeg je Dagrapport PC Sortering 01-01-2018.xlsm en Dagrapport PC Sortering 02-01-2018.xlsm enz.
En in cel M3 werd ineens de datum die gebruikt werd in de bestandsnaam ook overgenomen.
Dit omdat ik in het begin van de maand telkens voor elke werkdag een rapport dien klaar te zetten .

Nu wil ik eigenlijk dat er gewoon de nummer die in Sheet data aanmaak in kolom A van 1 tem 53 staan , worden gebruikt in de bestand naam op de plaats van de datum.
Dit hoeft niet perse een weeknummer te zijn die gegenereerd wordt , dat mag ook gewoon een getal zijn , want deze vul ik toch steeds in in tabblad Data aanmaak.
En de bestanden zouden moeten worden opgeslagen op G:\Pakketten\Mag-Data\Aanmaak Dagrapporten\aangemaakte\Onderhoud
Met als naam Weekrapport onderhoud week 1 .xlsm en Weekrapport onderhoud week 2 .xlsm , enz. Als er op Sheet data aanmaak op A1 1 staat en A2 2 staat enz.

Hopelijk heb ik het hiermee iets meer verduidelijkt wat de bedoeling is.

 

[VenA]

Waarom wil je 53 keer hetzelfde bestand opslaan? Waarom sluit de geplaatste code niet aan aan bij het het bestand? Waarom staat er niets in het bestand behalve een paar nummers?

Mogelijk zo al betwijfel ik het.

Sub VenA()
  c00 = "G:\Pakketten\Mag-Data\Aanmaak Dagrapporten\aangemaakte\Onderhoud\"
  ar = Sheets("Data Aanmaak").Cells(1).CurrentRegion
  For j = 1 To UBound(ar)
    ActiveWorkbook.SaveCopyAs c00 & "week " & ar(j, 1) & ".xlsm"
  Next j
End Sub

 

[davylenders123]

VenA

Eerst al bedankt voor je snelle reactie:thumb:

Deze werkt :thumb:

Maar nog niet dat de nummer die in de naam van het bestand wordt opgenomen, ook wordt ingevuld in de andere sheet , Sheet Pharmasortering in de cel M3 in het bestand.
Bv in het bestand met naam week 1 zou in Sheet Pharmasortering in de cel M3 een 1 moeten komen en in het bestand week 2 een 2 in M3 Enz.

Antwoorden op je vragen

Waarom wil je 53 keer hetzelfde bestand opslaan?
Dit is voor een bestand dat ik in het begin van een jaar klaar moet zetten voor de gebruikers voor het hele jaar. Dit bestand moeten ze dagelijks invullen en wordt dagelijks gemaild.
Omdat het door het jaar regelmatig gebeurt dat er wijzigingen aan het rapport of de mail macro moeten worden aangebracht , is het makkelijk dat ik door een macro de bestanden opnieuw kan aanmaken voor het hele jaar tot dan.

Waarom sluit de geplaatste code niet aan aan bij het het bestand?
Ik dacht dat omdat er in de code van cow18 in de Function nog voor datum en weekdag werd gesproken.

Waarom staat er niets in het bestand behalve een paar nummers?
Het bestand dat ik geplaatst heb als vb was maar beperkt omdat ik in het origineel bestand overal moest kijken of er geen info in stond die ik niet mocht posten. Daarom had ik even een bestandje gemaakt met de belangrijkste zaken erin.
Maar het originele bestand bevat veel meer informatie.

 

[VenA]

Dat kan je zelf toch wel?

Sheets("Pharmasortering").[M3] = ar(j,1)

Mag je zelf even puzzelen waar je het allemaal neer kan zetten.

 

[davylenders123]

VenA

Ik heb gepuzzeld maar geraak er met de beste wil van de wereld niet uit.

Ik kan aan bestaande codes wel kleine wijzigingen aanbrengen al , en dit is waarschijnlijk een kleine wijziging volgens u maar lukt me echt niet.

Ik vermoed dat het in de regel van ActiveWorkbook.SaveCopyAs moet worden toegevoegd , maar weet niet juist hoe want krijg steeds foutmeldingen.
Zal waarschijnlijk nog een beetje bij je regel bij moeten als deze daar ingepast moet worden , maar je moet natuurlijk weten wat.

Alles is makkelijk , als je weet hoe het moet :d

 

[cow18]

Sub VenA()
    c00 = "G:\Pakketten\Mag-Data\Aanmaak Dagrapporten\aangemaakte\Onderhoud\"
    ar = Sheets("Data Aanmaak").Cells(1).CurrentRegion
    For j = 1 To UBound(ar)
        Sheets("Pharmasortering").[M3] = ar(j, 1)
        ActiveWorkbook.SaveCopyAs c00 & "week " & ar(j, 1) & ".xlsm"
    Next j
End Sub

 

[davylenders123]

Dit is hem :thumb:

Alle bedankt voor jullie hulp , dit bespaart mij weer veel tijd :thumb:

Ik moet wel toegeven dat ik deze laatste toch had moeten vinden.
Had in het begin de regel ook op deze plaats gezet , maar kreeg een foutmelding.
Dan ben ik deze in de regel daaronder beginnen proberen toe te voegen en daar was ik er achtergekomen dat er bij ("Pharmasortering") een " achteraan ontbrak.
Maar heb toen de regel daar niet meer proberen te plaatsen. Stom van mij.