XL 2013 Copier des lignes vers une autre feuille avec VBA

[Citronflexe]

Bonjour le forum,

J'expose mon problème :

Je souhaite pouvoir copier la VALEUR de certaines cellules vers une nouvelle feuille créée dans la foulée.

Ci-dessous mon code pour le moment :

Private Sub CommandButton1_Click()

Range("A1", "R90").Select
Range("A1", "R90").Copy

Sheets.Add(After:=Worksheets("Planning")).Name = "Réunion Planning du " & Range("AX1") & "-" & Range("AY1") & "-" & Range("AZ1")

End Sub

Donc j'arrive bien à sélectionner et copier les cellules qui m'intéressent, la feuille est créée avec le nom souhaité, mais je ne sais pas comment comment coller uniquement les valeurs dans la nouvelle feuille. Lorsque je fais Ctrl+V ça copie les formules par défaut.
J'ai remarqué que lorsque colle avec Ctrl+V, le filtre que j'ai placé sur la ligne deux ne suit pas.. y'a-t-il un moyen de corriger cela ?

Je joins un fichier qui sera sûrement plus clair que mes explications...

Merci d'avance !!


Bruno

 

[Lone-wolf]

Bonjour Bruno

Supprime la ligne avec .Select

Range("A1", "R90").Copy

ActiveSheet. Range("a1").PasteSpecial Paste:=xlPasteValues - cellule à adapter
Application.CutCopyMode = 0
Application.GoTo Activesheet.Range("a1")

Sinon comme ceci, sans besoin du bouton; à copier dans ThisWorkbook

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim nom As String

With Sheets("Planning")
.Range("a1", "r90").Copy
nom = "Réunion Planning du " & .Range("AX1") & "-" & .Range("AY1") & "-" & .Range("AZ1")
End With

With Sh
.Range("a1").PasteSpecial Paste:=xlPasteValues
.Name = nom
Application.CutCopyMode = 0
Application.GoTo .Range("a1")
End With
End Sub

 

[Citronflexe]

Bonjour Lone-wolf,

Merci beaucoup de ta réponse.

Ca marche très bien pour la copie.
J'ai oublié de préciser, est-il possible de garder aussi la mise en forme ?

Et du coup, pour le filtre, je dois le refaire manuellement ?

Merci!

Bruno

 

[Lone-wolf]

Re

Pour la mise en forme et le filtre il faut ajouter ceci

.Range("a1").PasteSpecial Paste:=xlPasteFormats
.Range("a2:r2").AutoFilter

@Citronflexe

Ajoute ceci en dessus de With Sheets("Planning")
Application.ScreenUpdating = False

 

[Citronflexe]

@Lone-wolf

Je n'ai pas encore essayé ton exemple de code, j'ai complété celui que j'avais commencé avec les précieuses infos que tu m'as donné.
Ca marche bien, seulement pour une question d'esthétique je n'arrive pas à garder la taille des cellules comme dans le premier tableau...
J'ai tenté avec des .Colums.Autofit mais dans le premier tableau, les cellules ne sont pas forcément gérées par de l'autofit...donc le rendu est pas top.

Je ne comprend pas comment marchera ton code, si je ne demande pas la création de la nouvelle feuille avec un CommandButton, quand va-t-elle se créer ?

Merci et désolé si j'ai du mal à suivre !


EDIT :
j'ai reussi à gérer les colonnes/lignes grâce à un autre topic XLD, avec :

For i = 1 To 200
ActiveSheet.Columns(i).ColumnWidth = Sheets("Planning").Columns(i).ColumnWidth
ActiveSheet.Rows(i).RowHeight = Sheets("Planning").Rows(i).RowHeight
Next

Bruno

 

[Lone-wolf]

Re

La feuille sera copiée quand tu cliquera sur + à côté de l'onglet.

Voici la macro au complet, tojours à mettre dans le module de ThisWorkbook.

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim nom As String

With Sheets("Planning")
.Range("a1", "r90").Copy
nom = "Réunion Planning du " & .Range("AX1") & "-" & .Range("AY1") & "-" & .Range("AZ1")
End With

With Sh
.Name = nom
.Range("a1").PasteSpecial Paste:=xlPasteValues
.Range("a1").PasteSpecial Paste:=xlPasteFormats
.Range("a1:r1").ColumnWidth = Sheets("Planning").Range("a1:r1").ColumnWidth
.Range("a2:r2").AutoFilter
Application.CutCopyMode = 0
Application.GoTo .Range("a1")
End With
End Sub

EDIT: Pourquoi avoir mis un nouveau classeur??

 

[Lone-wolf]

@Citronflexe

Edit 2:

With Sheets("Planning")
derlig = .Range("o" & Rows.Count).End(xlUp).Row
.Range("a1:as" & derlig).Copy
nom = "Réunion Planning du " & .Range("AX1") & "-" & .Range("AY1") & "-" & .Range("AZ1")
End With

À remplacer par le précédent.

 

[Citronflexe]

@Lone-wolf

Re,

Bon je n'arrive pas à faire fonctionner ce que tu m'as partagé.. je dois me tromper dans ce que j'ajoute avant les .Name, .Range etc...

Je te partage le code final adapté à mon vrai fichier :

Private Sub CommandButton3_Click()

Dim i As Integer

Range("A1", "AU90").Copy
Sheets.Add(After:=Worksheets("SALLE B")).Name = "Réunion Planning du " & Range("K2") & "-" & Range("L2") & "-" & Range("M2")
ActiveSheet.Range("a1").PasteSpecial Paste:=xlPasteValues
ActiveSheet.Range("a1").PasteSpecial Paste:=xlPasteFormats
ActiveSheet.Range("a4:au4").AutoFilter
Application.CutCopyMode = 0
Application.GoTo ActiveSheet.Range("a1")
ActiveSheet.Columns("Q:AR").Hidden = True
ActiveWindow.Zoom = 85

For i = 1 To 200
ActiveSheet.Columns(i).ColumnWidth = Sheets("SALLE B").Columns(i).ColumnWidth
ActiveSheet.Rows(i).RowHeight = Sheets("SALLE B").Rows(i).RowHeight
Next

End Sub

Je sais pas si du coup c'est le mieux niveau optimisation mais ça à l'air de fonctionner..

Merci beaucoup pour ton aide !

Bruno

 

[Lone-wolf]

Re

Pourquoi la boucle?? Elle ne sert à rien. Et arrête de modifier les plages purée. D'abord de A à R, maintenant de A à AU. Faudrait savoir.
Et dans le nouveau classeur que tu as mis, k2 - l2 sont vides.

Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim nom As String, derlig As Long

    With Sheets("Planning")
        derlig = .Range("o" & Rows.Count).End(xlUp).Row
        .Range("a1:as" & derlig).Copy
        nom = "Réunion Planning du " & Range("K2") & "-" & Range("L2") & "-" & Range("M2")
    End With

    With Sh
        .Name = nom
        .Range("a1").PasteSpecial Paste:=xlPasteValues
        .Range("a1").PasteSpecial Paste:=xlPasteFormats
        .Range("a1:r1").ColumnWidth = Sheets("Planning").Range("a1:r1").ColumnWidth
        .Range("a2:r2").AutoFilter
        Application.CutCopyMode = 0
        Application.GoTo .Range("a1")
    End With
End Sub

 

[Citronflexe]

Re,

Les plages ne sont pas les mêmes car le fichier que j'ai transmis est un exemple, le code que j'ai envoyé précédemment est celui du fichier que j'utilise dans mon entreprise.
Désolé de la confusion et du coup de ton énervement a priori.

J'ai testé ton code du coup, ça fonctionne parfaitement, merci! Seul bémol, j'arrive plus à insérer de feuilles sans que cela crée la feuille "réunion de planning ...".

Maintenant la boucle :
c'est une solution que j'ai trouvé en faisant une recherche sur ce forum, pour donner les mêmes dimensions aux cellules dans les deux tableaux.
Ca m'a paru clair et au moins je comprends la démarche, et en plus, cela fonctionne.

Je vais essayer de la remplacer par :

ActiveSheet.Range("A1:R1").ColumnWidth = Sheets("Planning").Range("A1:R1").ColumnWidth
ActiveSheet.Range("A1:R1").RowHeight = Sheets("Planning").Range("A1:R1").RowHeight

pour que tu ne me cries pas dessus !


Merci,

Bruno

 

[Lone-wolf]

Re

À nouveau, pas besoin de boucle. La ligne que je t'ai montré fait exactement la même chose.

Pour les lignes

ActiveSheet.Rows("1:200").RowHeight = Sheets("Planning").Rows("1:200").RowHeight