XL 2016 copier coller via bouton macro avec decalage

[nounou1902]

Bonjour,

après avoir chercher toute la matinée sans réussir a trouver le code logique à associer à la macro voici se que je souhaite réaliser :

J'aimerais déplacer via un bouton la plage de donnée correspondante à la feuille "rapport d'expansion" de la (la plage de donnée va de =A1:AD30"
et j'aimerais la collé à un intervalle de 9 ligne par exemple suivant le bas de la dernière sélection (donc ligne 30) j'aimerais le collé a la ligne 40.
Donc à partir de la je sais faire mais si je reclique sur le bouton j'aimerais reporter ces 9 lignes d'intervalle encore en dessous de sorte à reporter le tableau toujours sur la même feuille sur les mêmes colonnes mais avec uniquement +9 ligne (peu importe le nombre il faut un écart toujours idem) en dessous en gardant tous les tableau créer.

Exemple :
copié A1:AD30
collé en A40:AD70
Puis encore une fois sans écraser le tableau du dessous
Copié A1:AD30
Collé en A80:AD110
etc...
ou tous simplement décaler tout les tableaux se trouvant en dessous de 9 ligne a chaque nouveau tableau créer

Vous trouverez ci-joint le fichier comprenant le copié collé via le bouton sans le décalage...

Ps : la feuille est protéger idéalement pendant la macro déverrouillé puis reverrouiller
Il faut également supprimer les valeurs inscrit de en D1,D2 et D3 ainsi que la plage de donnée du tableau principal en =A5:N30

Merci pour tous si quelqu'un à la réponse et merci à ceux qui auront essayer

Bien à vous

 

[shinozak]

Bonjour,
Peux tu m'envoyer le code par message, je n'arrive pas à télécharger le fichier

 

[nounou1902]

Oui voici le code :

Sub nouvelle_feuille_de_production()
'
' nouvelle_feuille_de_production Macro
'

'
Range("A1:AD30").Select
Selection.Copy
Application.CutCopyMode = False
ActiveSheet.Unprotect
Selection.Copy
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveWindow.SmallScroll Down:=12
Range("A40").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-27
Range("B2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "6H"
Range("B1:B3").Select
Selection.ClearContents
Range("A5:N30").Select
Selection.ClearContents
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub



Ps : je suis assez novice en la matière il se peut que j'ai effectuer des clic sans important je pense.

Merci pour ton aide

 

[shinozak]

Essaie ça :

Sub test()
ActiveSheet.Unprotect

Range("A1:AD30").Copy
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 10).Select
ActiveSheet.Paste

Range("D1:D3").ClearContents
Range("A5:N30").ClearContents

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

 

[nounou1902]

Impeccable c'est exactement ça !! au top !!!!!
Le seul petit bémol c'est que je pense que je doit augmenter une valeur car les tableaux se créer tellement près que ils effacent des lignes les uns les autres.

Exemple mon tableau fait 26 LIGNES il se collent en bas parfaitement en entier DONC 26 LIGNE et si je colle de nouveau il va collé par dessus et garder que 6 LIGNES comme ont peut le voir sur la photo ci-joint.

 

[nounou1902]

je vais essayer d'augmenter ton chiffre de Row + 10

 

[nounou1902]

C'est bon c'était ça merci beaucoup tu ma été d'une aide précieuse en temps !
Question comment as tu appris à coder en VBA par curiosité ?

 

[shinozak]

C'est bon c'était ça merci beaucoup tu ma été d'une aide précieuse en temps !
Question comment as tu appris à coder en VBA par curiosité ?

Je ne pouvais pas ouvrir le fichier, du coup le calcul de la dernière ligne se fait sur la colonne A, or sur ta capture d'écran je vois que la colonne A n'est pas remplit alors que la colonne AD est remplit du coup essaie ça :

Sub test()
ActiveSheet.Unprotect

Range("A1:AD30").Copy
Range("A" & Range("AD" & Rows.Count).End(xlUp).Row + 10).Select
ActiveSheet.Paste

Range("D1:D3").ClearContents
Range("A5:N30").ClearContents

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Si c'est OK, tu peux marquer cette réponse en solution.

 

[nounou1902]

J'ai juste adapter mes coordonnées mes la première solution était la bonne je n'est pas eu besoin de plus ! Merci beaucoup