Macro verkorten

[lsvleeuwen]

Ik heb een macro die een aantal gegevens bij de juiste dag in de juiste week in de juiste periode moet plakken.
Het is telkens hetzelfde stuk macro maar met andere cellen. Dit stuk heb ik dus 7(dagen/week)x13(periodes)=91x.
Ik hoop dat dit korter kan zodat onderhoud ook eenvoudiger wordt.

Sub a()

Dim x As Integer
Dim y As Integer
x = Worksheets(7).Range("K2")
y = Worksheets(7).Range("H2")

If y = Worksheets(13).Range("B1") Then
        If x = Worksheets(13).Range("D1") Then
       Sheets(13).Visible = True
        Sheets(13).Select
        ActiveSheet.Unprotect Password:="*****"
        Worksheets(11).Select
            Range("Y9:Z45").Select
            Selection.Copy
            Worksheets(13).Select
            Range("D4").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Worksheets(11).Select
            Range("AB5:AD5").Select
            Selection.Copy
            Worksheets(13).Select
            Range("U4").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Sheets(13).Select
        ActiveSheet.Protect Password:="*****"
    ActiveWindow.SelectedSheets.Visible = False
Sheets(7).Select
         End If
End If

 

[Cobbe]

Is dit al beter?

  Sub a()

Dim x As Integer
Dim y As Integer
x = Worksheets(7).Range("K2")
y = Worksheets(7).Range("H2")

If y = Worksheets(13).Range("B1") Then
   If x = Worksheets(13).Range("D1") Then
      With Sheets(13)
           .Visible = True
           .Unprotect Password:="*****"
        Worksheets(11).Range("Y9:Z45").Copy
           .Range("D4").PasteSpecial Paste:=xlPasteValues
        Worksheets(11).Range("AB5:AD5").Copy
           .Range("U4").PasteSpecial Paste:=xlPasteValues
           .Protect Password:="*****"
           .Visible = False
       End With
   End If
End If
End Sub

 

[VenA]

Als ik het goed gelezen/begrepen heb volstaat dit

Sub VenA()
With Sheets(13)
    If Sheets(7).[k2] = .[b1] And Sheets(7).[h2] = .[D1] Then
        .Unprotect "*****"
        Sheets(11).[Y9:Z45].Copy .[D4]
        Sheets(11).[AB5:AD5].Copy .[U4]
        .Protect "*****"
    End If
End With
End Sub

 

[lsvleeuwen]

Bedankt!

Bedankt Cobbe! Zeker al beter. Ik had al iets over die functie gelezen, maar nu snap ik ook hoe ik hem toe moet passen, dank je. Alleen dit stukje code heb ik nu nog steeds 312 keer.
Ik heb namelijk 13 periode-knoppen met daarachter dus 24 keer dat stukje code.
Het volgende in sub a zou dit zijn:

If y = Worksheets(13).Range("B1") Then
        If x = Worksheets(13).Range("F1") Then
        With Sheets(13)
                      .Visible = True
                      .Unprotect Password:="*****"
             Worksheets(11).Range("Y9:Z45").Copy
                      .Range("F4").PasteSpecial Paste:=xlPasteValues
             Worksheets(11).Range("AB5:AD5").Copy
                      .Range("U5").PasteSpecial Paste:=xlPasteValues
                      .Protect Password:="*****"
                      .Visible = False
  End With
        Sheets(7).Select
    End If
End If

Dus per sub heb ik 24 keer zo'n stukje code en dat voor 13 subs. Kan dit korter?

 

[VenA]

Staat net boven jouw berichtje.:d Kan je even een voorbeeldje van jouw bestand plaatsen. Ik begrijp niet helemaal wat je allemaal aan het doen bent en mogelijk dat het een stuk eenvoudiger kan.

 

[lsvleeuwen]

Is inmiddels een aardig bestand, dus heb even het relevante eruit gehaald en de namen weggehaald.
Even voor de duidelijkheid, Worksheet 7 is Vulploeginformatie, Worksheet 11 is Rekenen en Worksheets 13-25 zijn de periodes 1-13.
De gegevens komen automatisch in Rekenen te staan, en vanuit daar moet het dus bij de juiste dag, in de juiste week en in de juiste periode komen.
Je klikt dus op de juiste periode-knop op het blad Vulploeginformatie om de macro te starten. Als je op de verkeerde knop drukt gebeurt er dus ook niets.
Alleen periode 2 klopt nu nog qua hoeveelheid namen, maar je zult zien dat als er namen toegevoegd moeten worden, je de hele macro nu aan moet passen.
Ik hoop dus dat dat probleem verholpen kan worden. Het is trouwens niet 91x maar 312x (Ma-Za en dan 4 weken per periode, dus 24x13)

Oke, ik kan dus maar 100 kb uploaden, maar zelfs een sterk vereenvoudigde versie is 815 kb...
Is hier een oplossing voor?

 

[lsvleeuwen]

Bij deze het bestand.Bekijk bijlage Planning.xlsb

 

[VenA]

Oke, ik kan dus maar 100 kb uploaden, maar zelfs een sterk vereenvoudigde versie is 815 kb...
Is hier een oplossing voor?

Als je het bestand opslaat als .xlsb dan wordt het en kleiner en je mag tot 1 Mb uploaden.

Edit

Het bestand in jouw linkje heeft maar 4 sheets. En de code gaat over sheets 7, 11 en 13 dan kan je beter even de bladnamen gebruiken. Want zo gaat er natuurlijk niets werken.

 

[snb]

Sub M_snb()
  With Sheets(13)
    If Sheets(7).[k2]&Sheets(7).[h2] = .[b1]& .[D1] Then
        .Unprotect "*****"
        .cells(4,4).resize(37,2)=Sheets(11).range("Y9:Z45").Value
        .cells(4,21).resize(,3)=Sheets(11).range("AB5:AD5").value
        .Protect "*****"
    End If
  End With
End Sub

 

[lsvleeuwen]

Oke, dit is inderdaad al een kort stukje code, dus dat is alvast top.
Alleen de cellen B1 en D1 veranderen ook iedere keer, dus ik zou het stukje code nu nog steeds 312x nodig hebben toch?
En de range waar het geplakt moet worden wijzigt ook iedere keer.

PS Die sheets kloppen in het originele document wel, vandaar de toelichting in een van mijn vorige posts.

 

[lsvleeuwen]

Ik heb hier het volledige bestand, de namen zijn eruit gehaald ivm privacy. Voor de code maakt dit niets uit.
Bekijk bijlage Planning v1.0.xlsb

 

[snb]

Verwijder alle samengevoegde cellen
Gebruik in ieder werkblad kolomA en rij 1
Gebruik geen indexnummers voor werkbladen, maar de codename 'Blad7' of de naam: sheets("periode 1")

 

[lsvleeuwen]

Sub M_snb()
  With Sheets(13)
    If Sheets(7).[H2]&Sheets(7).[K2] = .[B1]& .[D1] Then
        .Unprotect "*****"
        .cells(4,4).resize(37,2)=Sheets(11).range("Y9:Z45").Value
        .cells(4,21).resize(,3)=Sheets(11).range("AB5:AD5").value
        .Protect "*****"
    End If
  End With

Als ik nu op het punt kom dat ik een naam toe moet voegen, dan moet ik toch nog steeds in alle losse stukjes code het bereik van .cells veranderen. En ik heb nu nog steeds 312x dit stukje code nodig, toch?
Want het volgende stukje zou nu dit worden:

With Sheets(13)
    If Sheets(7).[H2]&Sheets(7).[K2] = .[B1]& .[F1] Then
        .Unprotect "*****"
        .cells(4,6).resize(37,2)=Sheets(11).range("Y9:Z45").Value
        .cells(5,21).resize(,3)=Sheets(11).range("AB5:AD5").value
        .Protect "*****"
    End If
  End With

EDIT

Hij plakt nu de formules i.p.v. alleen de waardes. Dus die PasteSpecial optie moet nog ergens?