Bij kopieren de output van gekopieerde blad in totaaloverzicht

[Stafmanager]

Hoi,

Zie bijgevoegde bestand:

Blad 3 is een blad wat in een wekelijkse cyclus zo'n 50 keer gekopieerd kan worden voor een nieuw evenement. Nu heb ik in dit document een periodeoverizcht verwerkt, die verwijst naar de in/output van dit blad. Ik wil eigenlijk dat elke kopie in de volgende regel opgenomen wordt in dit periodeoverzicht. Hoe doe ik dat?

Thnx!

 

[Stafmanager]

Nee, heb het dus niet duidelijk uitgelegd:

Blad 3 wordt steeds opnieuw gekopieerd voor andere input in dit document. Ik wil dat elk gekopieerd blad een nieuwe regel wordt in periodeoverzicht waarin dezelfde cellen weergegven worden, maar dan van het gekopieerde blad.

 

[Stafmanager]

Hoi Cobbe,

In dit document gaat de medewerker op blad 3 staan, selecteert blad kopieeren, kopie maken, dus krijg je blad 3(2) in ditzelfde document. Dezelfde cellen in blad 3(2) als in blad 3(origineel) moeten een nieuwe regel vormen in periodeoverizcht. Zo krijg ik per week een totaaloverzicht van alle banquetingactiviteiten.

Maar misschien is het toch makkelijker om gewoon al 50 werkbladen te maken met koppeling erin naar het periodeoverzicht?

 

[Stafmanager]

Van mij mag er een button bijkomen, maar ik denk dat jij iets anders bedoeld met printen dan ik, dus dat geeft verwarring. Ik denk dat jij met printen "wegschrijven op periodeoverzicht" bedoeld, klopt dat?

 

[Warme bakkertje]

Wordt Blad3(2) na het invullen en uitprinten verwijdert of wordt het dan bijgevoegd onder een andere naam ?
Wordt de kopie altijd als laatste blad in de rij geplaatst, dit is nl belangrijk voor het schrijven v/d macro.

 

[Warme bakkertje]

Zo zou het bv kunnen als de kopie als laatste blad staat

Sub kopie()
    Dim data(12)
    With Sheets(Sheets.Count)
        data(0) = .Range("C8")
        data(1) = .Range("C12")
        data(2) = .Range("E8")
        data(3) = .Range("E11")
        'ga verder voor elke gewenste cel
    End With
    Sheets("Periodeoverzicht").Range("A" & Rows.Count).End(xlUp).Offset(1) = data
End Sub

 

[Stafmanager]

Blad 3(2) blijft in het document. Het uitprinten is vooraf aan de partij en achteraf voor de klant, maar dan kan het blad als bijlage verzonden worden. Het maakt niet uit of blad 3(2) als eerste of als laatste erin komt, ik schrijf de werkinstructie op basis van het document. Dus als het voor de macro als laatste (of eerste) moet, is dat geen probleem.

 

[Warme bakkertje]

Zo gaat ie beter

Sub kopie()
    Dim data(12)
    With Sheets(Sheets.Count)
        data(0) = .Range("C8")
        data(1) = .Range("C12")
        data(2) = .Range("E8")
        data(3) = .Range("E11")
        data(4) = .Range("C142")
        data(5) = .Range("C143")
        data(6) = .Range("C144")
        data(7) = .Range("C145")
        data(9) = .Range("E142") / 1.06
        data(10) = WorksheetFunction.Sum(.Range("E143:E145")) / 1.19
        data(11) = WorksheetFunction.Sum(.Range("E142:E145"))
        data(8) = data(11) - (data(9) + data(10))
    End With
    Sheets("Periodeoverzicht").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 12) = data
End Sub

 

[Warme bakkertje]

@ Cobbe

.Range("A6500")

Ge leert het niet af hé

 

[Stafmanager]

@bakkertje:

als ik jouw reeks in een macro plak, doet ie nix...

@cobbe:

om de een of andere reden wil hij de macro's niet activeren als ik je bestand open...

grr!!

 

[Stafmanager]

@cobbe:

Dom! vergeten macro's in te schakelen...

 

[Stafmanager]

@Cobbe en bakkertje:

Ik heb nu de macro van cobbe gekopieerd in mijn bestand, maar waar moet ik die range dan veranderen? Hij schrijft idd alleen de 1e vier kolommen weg, vanaf f&b laag niets... Zou het daarnaast ook nog mogelijk zijn om de macro aan te vullen dat het kopieblad leeg wordt gemaakt voor gebruik?

 

[Stafmanager]

Hoi!
Heb nu zelf de macro opgenomen. Het enige wat ik er nog aan toe moet voegen is dat hij dezelfde cellen van het "gekopieerde blad" blad 1(2) in een nieuwe regel in het blad weekoverzicht toevoegt.

Sub overzicht()
'
' overzicht Macro
'

'
    Sheets("Weekoverzicht").Select
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "='1'!R[4]C[2]"
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "='1'!R[8]C[1]"
    Range("C4").Select
    ActiveCell.FormulaR1C1 = "='1'!R[4]C[2]"
    Range("D4").Select
    ActiveCell.FormulaR1C1 = "='1'!R[7]C[1]"
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "='1'!R[138]C[-2]"
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "='1'!R[139]C[-3]"
    Range("G4").Select
    ActiveCell.FormulaR1C1 = "='1'!R[140]C[-4]"
    Range("H4").Select
    ActiveCell.FormulaR1C1 = "='1'!R[141]C[-5]"
    Range("L4").Select
    ActiveCell.FormulaR1C1 = "=SUM('1'!R[138]C[-7]:R[141]C[-7])"
    Range("K4").Select
    ActiveCell.FormulaR1C1 = "=(SUM('1'!R[139]C[-6]:R[141]C[-6])/1.19)"
    Range("J4").Select
    ActiveCell.FormulaR1C1 = "='1'!R[138]C[-5]/1.06"
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "=RC[3]-(RC[2]+RC[1])"
    Range("I5").Select
    Sheets("1").Select
    Sheets("1").Copy Before:=Sheets(2)
    Range("E132:E137,E125:E129,E103:E122,E76:E100,E55:E73,E49:E52,E21:E46").Select
    Range("E46").Activate
    ActiveWindow.SmallScroll Down:=-16
    Range( _
        "E132:E137,E125:E129,E103:E122,E76:E100,E55:E73,E49:E52,E21:E46,E8:E12,C8:C12") _
        .Select
    Range("C12").Activate
    Selection.ClearContents
End Sub

Hellup!!

 

[Warme bakkertje]

Hoe wil je het nu feitelijk ?
Eerst zeg je dat je een kopie neemt en deze dan invult, nu ga je weer eerst je origineel invullen en dan een kopie nemen ???

Sub kopie()
    Dim data(12)
    With Sheets("1")
        data(0) = .Range("C8")
        data(1) = .Range("C12")
        data(2) = .Range("E8")
        data(3) = .Range("E11")
        data(4) = .Range("C142")
        data(5) = .Range("C143")
        data(6) = .Range("C144")
        data(7) = .Range("C145")
        data(9) = .Range("E142") / 1.06
        data(10) = WorksheetFunction.Sum(.Range("E143:E145")) / 1.19
        data(11) = WorksheetFunction.Sum(.Range("E142:E145"))
        data(8) = data(11) - (data(9) + data(10))
        .Copy Before:=Sheets(2)
        .Range( _
        "E132:E137,E125:E129,E103:E122,E76:E100,E55:E73,E49:E52,E21:E46,E8:E12,C8:C12") _
        .ClearContents
    End With
    Sheets("Periodeoverzicht").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 12) = data
End Sub

 

[Stafmanager]

Super bedankt! Het werkt!