Nieuw bestand aanmaken

Status
Niet open voor verdere reacties.
E

Emelkert

Gebruiker
Lid geworden
18 mrt 2016
Berichten
61
Hallo,
Na veelvuldig op internet zitten zoeken ben ik niet tot een goed resultaat gekomen, vandaar dat ik mijn vraag tot de pro's richt.
Ik wil dmv een knop dat er een nieuw bestand word gemaakt en ben al aardig over de helft.

Het gene wat er nog moet gebeuren:

Het nieuwe bestand moet opgeslagen worden onder de naam die vermeld staat in cel MDF002.
Het nieuwe bestand moet alle macro's hebben die te vinden zijn in de module "Codes_personalia".
De naam van pagina ''Nieuw jaar (2)'' moet aangepast worden naar het jaartal dat je vind bij F3.
Daarna moet rij 4 gekopieerd worden, omlaag geschoven worden waarna de nieuwe gegevens moeten worden geplakt op rij 4 (nieuwste regel is dus boven)
Alle verwijzingen in de formules (van kolom B t/m kolom P) moeten daarna aan het nieuwe bestand worden gekoppeld, evenals de hyperlink in de nieuwe B4.

Tips?

Bekijk bijlage 268373
 
Tip 1:
Plaats een geldige bijlage :cool:
 
Overigens heb ik al een beginsel in het VBA gemaakt. Ik geloof dat dat wel handig is. Mocht t waardeloos zijn, ben je vrij om een nieuwe te typen.
 
Kijk maar wat er aan schort.
Wat niet kan is dat je twee bladen wil benoemen met dezelfde naam 2016 (F3 en I29).
Je zal daarom I29 in je voorbeeld moeten veranderen in 2015.
Codemodule "Codes_test_bestand" wordt verwijderd in het nieuwe bestand.

Code: 
Sub Nieuwe_medewerker()
Dim sh As Worksheet, Wbname
Application.DisplayAlerts = False
With ThisWorkbook
   For Each sh In .Sheets
    sh.Visible = True
   Next sh


Wbname = ThisWorkbook.Path & "\" & .Sheets("Pers.overzicht").[b3].Value & ".xlsm"
  .SaveCopyAs Wbname
  Workbooks.Open (Wbname)
 Set Wbname = Workbooks(.Sheets("Pers.overzicht").[b3].Value & ".xlsm")
      Wbname.Sheets(1).Name = .Sheets("Pers.overzicht").[f3].Value
      Wbname.Sheets(3).Name = .Sheets("personalia").[i29].Value


        With .Sheets("personalia")
           .Unprotect
           .[i29].Value = .[i29].Value + 1
           .EnableSelection = xlUnlockedCells
           .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        End With
     
     .Sheets("Nieuw jaar").Visible = False
     .Sheets("Personalia").Visible = False
 End With
 With Wbname.VBProject
   .VBComponents.Remove .VBComponents("Codes_test_bestand")
 End With
Wbname.Close 1
Application.DisplayAlerts = True
End Sub
 
Sorry HSV, Ik heb niet genoeg informatie gegeven..:o

De pagina Pers.Overzicht moet niet gekopieerd worden.
De eerste pagina in het nieuwe bestand moet tabblad "nieuw jaar" zijn.
De 2de pagina moet "personalia zijn".
De derde pagina "Nieuw jaar" moet de naam van F3 in het oorspronkelijke document ("Test bestand") krijgen (resultaat: 2016). De namen van de andere 2 pagina's moeten niet aangepast worden.

Het nieuwe document moet de naam van B3 uit het oorspronkelijke document ("Test bestand") hebben MDF002 (was al gelukt zag ik).

Hoe kreeg je t voor elkaar om de macro's ook over te zetten?
Ik kreeg trouwens een foutmelding bij "With Wbname.VBProject"

Best aardig dag je cel I29 had gevonden :), deze heeft alleen te maken met nieuwe jaren.
Gezien je hem toch heb gevonden en al een +1 regel aan toe heb gevoegd, moet ie eerst de waarde krijgen van F3 in het oorspronkelijke document ("Test bestand").
Dit ivm met de aanmaak van een nieuw jaar waarvan de naam aangepast moet worden naar het huidige jaar.
 
Wat er daarna nog moet gebeuren in het "Test bestand" is dat rij 4 gekopieerd moet worden
De gekopieerde cellen moeten op dezelfde rij ingevoegd worden waardoor de huidige rij 4 omlaag geschoven word.
De nieuwste rij komt dus altijd bovenaan.
Alle verwijzingen in de formules (van kolom B t/m kolom P) moeten daarna aan het nieuwe bestand worden gekoppeld.
In rij B zitten hyperlinks naar de bestanden. Deze moet ook aangepast worden.
 
Nu begint het te dagen... Na 3x lezen begin ik het een beetje te snappen.
Ik heb zelf ook aan de code zitten sleutelen. Als je deze code uitvoert, word mijn bedoeling wat duidelijker.
Alleen moet het stukje wat in mijn berichtje hierboven is beschreven nog verwerkt worden in het "Test bestand".

Code: 
Sub Nieuw_bestand()
Dim sh As Worksheet, Wbname
Application.DisplayAlerts = False
With ThisWorkbook
    For Each sh In .Sheets
    sh.Visible = True
    Next sh
    Sheets("Personalia").Select
    ActiveSheet.Unprotect
    Range("I29") = ['Pers.Overzicht'!F3]
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("Pers.Overzicht").Select

    Wbname = ThisWorkbook.Path & "\" & .Sheets("Pers.overzicht").[b3].Value & ".xlsm"
    .SaveCopyAs Wbname
    Workbooks.Open (Wbname)
    Set Wbname = Workbooks(.Sheets("Pers.overzicht").[b3].Value & ".xlsm")

End With
Worksheets("Pers.Overzicht").Delete
Sheets("Nieuw jaar").Copy After:=Sheets(2)
ActiveSheet.Name = ['Personalia'!I29]
ActiveSheet.Unprotect
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Range("F3").Select
Sheets("Nieuw jaar").Visible = False
Sheets("Personalia").Select
ActiveSheet.Unprotect
Application.DisplayAlerts = True
Range("F27") = Range("I29")
Range("I24").Select
Selection.Copy
Range("J24").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("I24").Select
ActiveCell.Replace What:=Range("H29"), Replacement:=Range("F27"), LookAt:=xlPart, _
    SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    Cells.Find(What:=Range("H29"), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False).Activate
If IsError(Range("I24")) Then
    Range("J24").Select
    Selection.Copy
    Range("I24").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("J22").Select
    Selection.Copy
    Range("J24").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("F6").Select
    Range("F27") = Range("F27") - 1
    MsgBox "Kan niet verder." & vbNewLine & vbNewLine & "Er moet eerst een nieuw jaar gemaakt worden.", vbOKOnly + vbCritical, "Actie fout"
    Antwoord = MsgBox("Maak eerst een nieuw kalenderjaar aan." & vbNewLine & vbNewLine & "Wil je dit nu doen?", vbYesNo + vbQuestion, "Jaar niet gevonden!")
    If Antwoord = vbNo Then
        MsgBox "Actie word ongedaan gemaakt.", vbOKOnly + vbExclamation, "Fout!"
    ElseIf Antwoord = vbYes Then
        Sheets("Nieuw jaar").Visible = True
        Sheets("Nieuw jaar").Copy After:=Sheets(2)
        ActiveSheet.Name = ['Personalia'!I29]
        ActiveSheet.Unprotect
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        ActiveSheet.EnableSelection = xlUnlockedCells
        Range("F3").Select
        Sheets("Nieuw jaar").Visible = False
        Sheets("Personalia").Select
        ActiveSheet.Unprotect
        Range("I29") = Range("I29") + 1
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        MsgBox "Jaar aangemaakt!", vbInformation, "Informatie"
        Run ("Jaar_Verhogen")
    End If
Else

    Range("J22").Select
    Selection.Copy
    Range("J24").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Cells.Replace What:=Range("H29"), Replacement:=Range("F27"), LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End If

Range("F6").Select
Range("I29") = Range("I29") + 1
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
MsgBox "Nieuw document voor personeel gemaakt!", vbInformation, "Informatie"
End Sub

Je heb mij al een heel stuk op weg geholpen HSV. Enorm bedankt :)
 
Ben weer even verder gegaan :thumb:
Ik heb in cel C3 nog een keer de bestandsnaam gemaakt zodat de formules aangepast kunnen worden.
Het enige wat nu niet lukt is de waardes van die cellen omhoog schuiven én de hyperlink.

De waarde van de cellen verschuiven staat nu zo geformuleerd:
Range("B3").Value = Range("B3").Value + 1
Maar dat geeft een fout melding...
Hoe ik de hyperlink goed moet krijgen weet ik helaas niet :(

Voor de duidelijkheid: In cel B3 staat nu MDF002 en in C3 staat MDF001



Code: 
Windows("Test bestand.xlsm").Activate
Rows("4:4").Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Rows("4:4").Select
Selection.Replace What:=Range("C3"), Replacement:=Range("B3"), LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
    
    Range("B4").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Range("B3")".xlsm"
    Range("B3").Value = Range("B3").Value + 1
    Range("C3").Value = Range("C3").Value + 1


MsgBox "Nieuw document voor personeel gemaakt!", vbInformation, "Informatie"

Wanneer je de laatste regel boven end sub van de vorige code vervangt door deze gehele code, hoef je hem alleen uit te voeren en ben je op het punt waar ik nu ook sta...
 
Het spijt me, maar ik lig er uit.

Jij schrijft dat je mijn code 3x hebt moeten lezen, maar ik heb jou schrijven al 10x gelezen, maar ik word er niet veel wijzer uit.
De code roept ook nog eens 'sub verhogen()' aan, enz, enz., dus die kan ik ook nog eens weer doornemen.
De code vliegt van hak op de tak.

Misschien is er iemand anders die je kan helpen.

Tip.
Gooi al die 'activate, select en selections' in je codes eruit en gebruik 'With sheets("blabla")'.rows(4).copy ipv
Rows("4:4").Select
Selection.Copy
 
HSV zei:
Het spijt me, maar ik lig er uit.

Jij schrijft dat je mijn code 3x hebt moeten lezen, maar ik heb jou schrijven al 10x gelezen, maar ik word er niet veel wijzer uit.
De code roept ook nog eens 'sub verhogen()' aan, enz, enz., dus die kan ik ook nog eens weer doornemen.
De code vliegt van hak op de tak.

Misschien is er iemand anders die je kan helpen.

Tip.
Gooi al die 'activate, select en selections' in je codes eruit en gebruik 'With sheets("blabla")'.rows(4).copy ipv
Rows("4:4").Select
Selection.Copy
Klik om te vergroten...

Ik heb nog nooit met vba gewerkt. Hetgene wat je nu ziet heb ik voornamelijk via het helpmij forum bij elkaar gekregen met een beetje hulp van t macro opnemen..

Ik ben tot net geen 1x de code With sheets gezien.. is er ergens een plek waar ik er meer over kan leren?
 
Schrijf eens stap voor stap op wat er in eerste instantie moet gebeuren; bv zoals ik hieronder omschrijf.
1). maak een kopie van het bestand "testbestand' en hernoem die met de waarde van 'testbestand' blad-pers.overzicht' cel B3.
2). Verwijder het blad 'pers.overzicht' van het nieuwe bestand omdat die niet gekopieerd hoeft te worden (er blijven dus twee bladen over).
3). Maak van tabblad 'Nieuw jaar' het eerste blad zodat 'personalia' op de tweede plaats komt.
4). Maak van blad "nieuw jaar' een kopie en plaats dit achter blad 'personalia' en benoem dat blad met de waarde uit cel F3 van 'testbestand' blad 'pers.overzicht'.
enz., enz.

Als het nieuwe bestand (MDF002) eenmaal vorm heeft, zien we wel verder (hyperlinks, verwijzingen).
 
HSV zei:
Schrijf eens stap voor stap op wat er in eerste instantie moet gebeuren; bv zoals ik hieronder omschrijf.
1). maak een kopie van het bestand "testbestand' en hernoem die met de waarde van 'testbestand' blad-pers.overzicht' cel B3.
2). Verwijder het blad 'pers.overzicht' van het nieuwe bestand omdat die niet gekopieerd hoeft te worden (er blijven dus twee bladen over).
3). Maak van tabblad 'Nieuw jaar' het eerste blad zodat 'personalia' op de tweede plaats komt.
4). Maak van blad "nieuw jaar' een kopie en plaats dit achter blad 'personalia' en benoem dat blad met de waarde uit cel F3 van 'testbestand' blad 'pers.overzicht'.
enz., enz.

Als het nieuwe bestand (MDF002) eenmaal vorm heeft, zien we wel verder (hyperlinks, verwijzingen).
Klik om te vergroten...

Ehm... Nou eigenlijk dat om te beginnen.

5). Verander jaartal van I29 naar volgend jaar (de waarde uit cel F3 van 'testbestand' blad 'pers.overzicht' + 1).
6). Verander elk jaartal dat in de formule van I25:I27 naar het huidige jaartal, evenals het jaartal op H29 en F27. (de waarde uit cel F3 van 'testbestand' blad 'pers.overzicht')
7). Pas de beveiliging van pagina 'personalia' & de pagina met huidig jaartal aan dat alleen de onbeveiligde cellen kunnen worden geselecteerd. (beveiliging staat momenteel dat niets kan worden geselecteerd)
8). Verberg pagina 'Nieuw jaar'.

test bestand.xlsm

9). Kopieer rij 4 en plak deze op een lege rij.
10). Verander alle verwijzingen in rij 4 naar het nieuwe bestand.
11). Plaats een hyperlink het nieuwe bestand.
12). Laat het getal in cel B3 1 omhoog gaan voor het volgende bestand.
13). Sorteer de rijen op basis van kolom B zodat alle rijen zijn gesorteerd op achternaam.
14). Beveilig het blad zodat niets bewerkt kan worden, maar dat de hyperlinks wel aangeklikt kunnen worden.
 
Laatst bewerkt:
Met onderstaande code ben ik tot punt 9.
Vanaf punt 9 moet je even aangeven naar welk lege regel.

Code: 
Sub Nieuwe_medewerker()
Dim sh As Worksheet, Wbname
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ThisWorkbook
   For Each sh In .Sheets
    sh.Visible = True
   Next sh


Wbname = ThisWorkbook.Path & "\" & .Sheets("Pers.overzicht").[b3].Value & ".xlsm"
  .SaveCopyAs Wbname
  Workbooks.Open (Wbname)
 Set Wbname = Workbooks(.Sheets("Pers.overzicht").[b3].Value & ".xlsm")
     With Wbname
         
         .Sheets.Add(, Sheets(Sheets.Count)).Name = .Sheets("Pers.overzicht").[f3]
         .Sheets(Array("Nieuw jaar", CStr(.Sheets("Pers.overzicht").[f3].Value))).FillAcrossSheets Sheets("Nieuw jaar").Cells
         .Sheets(CStr(.Sheets("Pers.overzicht").[f3].Value)).Protect
         .Sheets("Nieuw jaar").Move .Sheets(1)
         
         With .Sheets("personalia")
           .Unprotect
           .[i29].Value = .Parent.Sheets("Pers.overzicht").[f3].Value + 1
           .Range("I25:I27").Replace "2015", Year(Now), xlPart
           .Range("f27,h29") = Year(Now)
           .EnableSelection = xlUnlockedCells
           .Protect
         End With
         With .Sheets(CStr(.Sheets("Pers.overzicht").[f3].Value))
           .Unprotect
           .Protect
         End With
       .Sheets("Pers.overzicht").Delete
       .Sheets("Nieuw jaar").Visible = False
     End With
     .Sheets("Nieuw jaar").Visible = False
     .Sheets("Personalia").Visible = False
 End With
 With Wbname.VBProject
   .VBComponents.Remove .VBComponents("Codes_test_bestand")
 End With
Wbname.Close 1
Application.DisplayAlerts = True
End Sub
 
T makkelijkste is als je hem op dezelfde regel plakt waardoor de rest naar beneden gaat. Ik weet alleen niet of je dan in de war komt met de sorteerfunctie...
 
Test het maar eens.
Je moet wel de samengevoegde cellen verwijderen uit rij 3 van 'pers.overzicht' zoals in onderstaand bestand.

Code: 
Sub Nieuwe_medewerker()
Dim sh As Worksheet, Wbname, c As Range, nwB
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ThisWorkbook
   For Each sh In .Sheets
    sh.Visible = True
   Next sh


Wbname = ThisWorkbook.Path & "\" & .Sheets("Pers.overzicht").[b3].Value & ".xlsm"
  .SaveCopyAs Wbname
  Workbooks.Open (Wbname)
 Set nwB = Workbooks(.Sheets("Pers.overzicht").[b3].Value & ".xlsm")
     With nwB
         .Sheets.Add(, Sheets(Sheets.Count)).Name = .Sheets("Pers.overzicht").[f3]
         .Sheets(Array("Nieuw jaar", CStr(.Sheets("Pers.overzicht").[f3].Value))).FillAcrossSheets Sheets("Nieuw jaar").Cells
         .Sheets(CStr(.Sheets("Pers.overzicht").[f3].Value)).Protect
         .Sheets("Nieuw jaar").Move .Sheets(1)
         
            With .Sheets("personalia")
              .Unprotect
              .[i29].Value = .Parent.Sheets("Pers.overzicht").[f3].Value + 1
              .Range("I25:I27").Replace "2015", Year(Now), xlPart
              .Range("f27,h29") = Year(Now)
              .EnableSelection = xlUnlockedCells
              .Protect
            End With
            With .Sheets(CStr(.Sheets("Pers.overzicht").[f3].Value))
              .Unprotect
              .Protect
            End With
       .Sheets("Pers.overzicht").Delete
     End With


 With nwB.VBProject
   .VBComponents.Remove .VBComponents("Codes_test_bestand")
 End With
   With .Sheets("pers.overzicht")
      .Unprotect
      .Cells(4, 2).Resize(2, 15).FillDown
      .Cells(Rows.Count, 2).End(xlUp).Resize(, 15).Replace "[*.xlsm]", "[" & .[b3] & "]", xlPart
      .Hyperlinks.Add .Cells(Rows.Count, 2).End(xlUp), nwB.FullName
      .Range("b3", .Range("b3").End(xlDown)).Resize(, 15).Sort .[b3], , , , , , , 1
      .[b3] = Format("MDF" + Format(Right(.[b3], 3) + 1, "000"))
      .Protect , , , , , , , , , , , 1
    End With
   nwB.Close 1
    .Sheets("Nieuw jaar").Visible = False
    .Sheets("Personalia").Visible = False
  End With
Application.DisplayAlerts = True
End Sub
 

Bijlagen

Hij doet het Harry,
Wel nog 3 vraagjes, bij het nieuw aangemaakte tabblad (2016) is alles geselecteerd en het blad is niet beveiligd, ook zie je overal een 0 terwijl op de pagina "personalia" & "nieuw jaar" alle waardes met een 0 verborgen zijn.
Overigens krijg ik de foutmelding op het moment dat je de code module codes_test_bestand wil verwijderen...

Is het nog mogelijk dat je dit nog in een code kan verwerken?
Thx alvast
 
De eerste twee opgelost.
De derde werkt hier goed in Excel 2007 maar misschien is het een versie probleem dus misschien kan ik nog iets zoeken naar de versie van jou.
Wat staat er in het berichtenvenster van de foutmelding?

Code: 
Sub Nieuwe_medewerker()
Dim sh As Worksheet, Wbname, c As Range, nwB
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ThisWorkbook
   For Each sh In .Sheets
    sh.Visible = True
   Next sh


Wbname = ThisWorkbook.Path & "\" & .Sheets("Pers.overzicht").[b3].Value & ".xlsm"
  .SaveCopyAs Wbname
  Workbooks.Open (Wbname)
 Set nwB = Workbooks(.Sheets("Pers.overzicht").[b3].Value & ".xlsm")
     With nwB
         .Sheets.Add(, Sheets(Sheets.Count)).Name = .Sheets("Pers.overzicht").[f3]
         .Sheets(Array("Nieuw jaar", CStr(.Sheets("Pers.overzicht").[f3].Value))).FillAcrossSheets Sheets("Nieuw jaar").Cells
         
         With .Sheets(CStr(.Sheets("Pers.overzicht").[f3].Value))
              Application.Goto .[a1]
              .EnableSelection = xlNoSelection
              .Protect , , , True
            End With
         .Sheets("Nieuw jaar").Move .Sheets(1)
         
            With .Sheets("personalia")
              .Unprotect
              .[i29].Value = .Parent.Sheets("Pers.overzicht").[f3].Value + 1
              .Range("I25:I27").Replace "2015", Year(Now), xlPart
              .Range("f27,h29") = Year(Now)
              .EnableSelection = xlUnlockedCells
              .Protect
            End With
            With .Sheets(CStr(.Sheets("Pers.overzicht").[f3].Value))
              .Unprotect
              .Protect
            End With
       .Sheets("Pers.overzicht").Delete
       .Sheets.Select
     ActiveWindow.DisplayZeros = False
  End With


 With nwB.VBProject
   .VBComponents.Remove .VBComponents("Codes_test_bestand")
 End With
   With .Sheets("pers.overzicht")
      .Unprotect
      .Cells(4, 2).Resize(2, 15).FillDown
      .Cells(Rows.Count, 2).End(xlUp).Resize(, 15).Replace "[*.xlsm]", "[" & .[b3] & "]", xlPart
      .Hyperlinks.Add .Cells(Rows.Count, 2).End(xlUp), nwB.FullName
      .Range("b3", .Range("b3").End(xlDown)).Resize(, 15).Sort .[b3], , , , , , , 1
      .[b3] = Format("MDF" + Format(Right(.[b3], 3) + 1, "000"))
      .Protect , , , , , , , , , , , 1
    End With
   nwB.Close 1
    .Sheets("Nieuw jaar").Visible = False
    .Sheets("Personalia").Visible = False
  End With
Application.DisplayAlerts = True
End Sub
 
Fout 1004 tijdens uitvoring:

Toegang tot het visual basic-project op programmeerniveau is niet betrouwbaar.

hij geeft de foutmelding bij de eerste regel van
With nwB.VBProject
.VBComponents.Remove .VBComponents("Codes_test_bestand")
End With
 
Als onderstaand niet werkt kan ik je daar niet verder mee helpen.
Ik heb de rode tekst aangepast, om rij 4 te kopiëren naar onderen voor MDF004, MDF005, enz.

Code: 
With [COLOR=#ff0000]ActiveWorkbook[/COLOR].VBProject
   .VBComponents.Remove .VBComponents("Codes_test_bestand")
 End With
   With .Sheets("pers.overzicht")
      .Unprotect
[COLOR=#ff0000]      .Cells(4, 2).Resize(, 15).Copy .Cells(Rows.Count, 2).End(xlUp).Offset(1)[/COLOR]
      .Cells(Rows.Count, 2).End(xlUp).Resize(, 15).Replace "[*.xlsm]", "[" & .[b3] & "]", xlPart
      .Hyperlinks.Add .Cells(Rows.Count, 2).End(xlUp), nwB.FullName
      .Range("b3", .Range("b3").End(xlDown)).Resize(, 15).Sort .[b3], , , , , , , 1
      .[b3] = Format("MDF" + Format(Right(.[b3], 3) + 1, "000"))
      .Protect , , , , , , , , , , , 1
    End With
   nwB.Close 1
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan