Kopiëren en plakken met allerlei randvoorwaarden.

[Multimeter]

Eureka, heb ondertussen met aanpassing van de code en andere codes hier en daar van forums etc getrokken bereikt wat ik wilde:
Alles werkt nu zoals bedoelt en er wordt met een druk op de knop een nieuwe tab aangemaakt voor de volgende maand waarbij
alles van onder de streep naar boven gekopieerd wordt, gewist wat er gewist moet worden.
Afijn de hele zaak weer klaar voor een nieuwe maand.
Iedereen bedankt voor het meedenken, de zaak is opgelost.

 

[emields]

Ik zou het resultaat wel eens willen zien, kwestie van iets bij te leren.

 

[Multimeter]

Emields

Ik ga het je sturen alleen heb het even druk en aangezien ik het in het uiteindelijke bestand ben verder gegaan moet ik het
helemaal opschonen.
Of je zou me een e-mail adres moeten doen toekomen dan kan ik het sneller want dan hoef ik er namelijk minder gegevens uit te halen.
Anders gaat het een paar dagen duren.

 

[Multimeter]

Ik zal voorlopig eerst alle code plaatsen, misschien is dat genoeg.
De opzet is enigszins veranderd in die zin dat ik nu de nummers in de A kolom gebruik om de plek op te zoeken waarnaar
gekopieerd gaat worden.

1ste module: Sub Paste()
'
' Paste Macro

With Cells(5, 1).CurrentRegion.Resize(, 5)
ar = .Value
ar1 = Cells(29, 1).CurrentRegion.Resize(, 5)
For jj = 1 To UBound(ar)
For j = 1 To UBound(ar1)
If ar(j, 1) = ar1(jj, 1) Then
ar(j, 2) = ar1(jj, 2)
ar(j, 3) = ar1(jj, 3)
ar(j, 5) = ar1(jj, 5)
ar(j, 4) = ""
Exit For
End If
Next j
Next jj
.Value = ar
End With
Range("A32:E41").ClearContents
End Sub

2de module:Sub New_Month()

Dim OrgWs As Worksheet
Dim NewWs As Worksheet
Set OrgWs = ActiveSheet

OrgWs.Copy after:=Worksheets(Worksheets.Count)

Set NewWs = ActiveSheet

NewWs.Name = Format(DateAdd("m", 1, DateValue("1 " & OrgWs.Name)), "mmmm yyyy")

End Sub

3de module:Function TabName()
TabName = ActiveSheet.Name
End Function

4de module:Sub Clear()
Range("H2:AL3").ClearContents

End Sub

5de module:Sub Button4_Click()
Call UnProtectSheets
Call New_Month
Call Paste
Call Clear
Call ProtectSheets



End Sub

6de module:Sub ProtectSheets()
Dim wsheet As Worksheet
For Each wsheet In ActiveWorkbook.Worksheets
wsheet.Protect Password:="thuishaven"
Next wsheet
End Sub

Het zal allemaal wel heel knullig inmekaar steken maar het werkt! Het nieuwe bestand heeft ook wat regels erbij gekregen zoals je ziet en zoals ik
al zei ik het het enigszins verandert wat betreft de selectie van de regel waar op geplakt wordt.

 

[Multimeter]

Emields

Ik krijg een aankondiging dat je me iets gestuurd heb maar kan niets vinden, als het klopt stuur het nog een keer.
Heb ondertussen de codes gestuurd dat was het snelste want zoals gezegd ga ik het een paar dagen druk krijgen.

 

[Multimeter]

het uiteindelijke bestand

Bekijk bijlage realisatie.xlsm

Emields

Het beloofde bestand is bijgevoegd na alles anoniem gemaakt te hebben en nog een uitleg verzonnen te hebben.
Test hem maar, voor mij werkt hij.

 

[emields]

Het bijzonderste is dat het doet wat je ervan verwacht.

 

[Multimeter]

Ben ik zelf ook verbaasd over en ik kan je ook zeggen dat ik van alle bijmekaar gezochte
en aanmekaar geknoopte codes lang niet alles begrijp.
Maar ben wel stukje bij beetje een heel klein beetje wijzer geworden, maar wees maar gerust een expert
worden zal niet gauw gebeuren en je zal me nog wel eens terug zien met eoa vraag.