Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 [VBA] Répétition copier coller tableau et mise en forme

T

Terreur

XLDnaute Nouveau
Bien le bonjour à tout le monde,

Je dois créer une sorte d’outil excel permettant de générer une feuille de devis pour les clients. Le ficher contient un onglet « Produits » où l’on coche les produits que l’on désire. Le nombre de cases cochées est récupéré sous la forme d’une variable. Un fois les produits cochés le but est de créer le devis via l’onglet « Devis ». Celui-ci se compose d’une première partie de tableau commune qui est contenu dans l’onglet « Tableau taille » puis de X tableaux issus de l’onglet « Tableau catégorie ». La macro copie/colle la première partie de tableau dans l’onglet « Devis » puis dois copier/coller X fois le nombre de tableau (onglet « Tableau catégorie ») à la suite de cette première partie de tableau avec une col. Chaque tableau copier/coller doit avoir le nom du produit correspondant coché à la place de « Produit A ».

Ma macro copie/colle bien la première partie de tableau mais là où ça bloque c’est lors de la création des autres tableaux avec l’espacement d’une colonne et le nom à la place de « Produit A ». Ma macro ne copie colle pas x fois le tableau et je ne vois pas comment changer le nom de chaque tableau afin que la case produit cochée remplace le nom « Produit A ».


Je vous mets une copie d’écran du résultat que j’essaie d’avoir ainsi que mon fichier et le code ci-dessous.


Merci grandement d’avance de votre aide les amis.


Terreur


Sub Creation_Tableaux()

'Déclaration nbre de tableaux à créer
Dim Nbtableaux As Integer
Nbtableaux = Sheets("Produits").Range("F14").Value

'Nettoyage feuille avec tableaux
Sheets("Devis").Cells.Clear

'Copier première partie tableau
Sheets("Tableau Taille").Select
Range("A1:B33").Copy
Sheets("Devis").Select
Range("B2").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 2.14


'Copier les tableaux
For i = 1 To Nbtableaux

Sheets("Tableau catégorie").Select
Range("A1:C33").Copy
Sheets("Devis").Select
Range("B2").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(0, 2).Select
ActiveSheet.Paste

Next

End Sub
 

Pièces jointes

  • Outil essai devis.xlsm
    29.5 KB · Affichages: 32
  • Résultat voulu.png
    105.9 KB · Affichages: 67
Trier par date Trier par votes

Yurperqod

XLDnaute Occasionnel
Bonjour le forum

Un essai pour la recopie des tableaux
J'ai utilisé la fonction Tableau
J'ai renommé tes tableaux existants en TAB_Taille et TAB_Cat
Est-ce que c'est un bon début ?
VB: 
Sub Creation_Tableaux()
'Déclaration nbre de tableaux à créer
Dim DerCol As Long, i As Long
Dim Nbtableaux As Integer
Nbtableaux = Sheets("Produits").Range("F14").Value
Sheets("Devis").Cells.Clear
Range("TAB_Taille[#All]").Copy Sheets("Devis").Cells(4, "B")
Range("TAB_Cat[#All]").Copy Sheets("Devis").Cells(4, "D")
'Copier les tableaux
For i = 1 To Nbtableaux
DerCol = Sheets("Devis").Cells(4, Columns.Count).End(xlToLeft).Column
Range("TAB_Taille[#All]").Copy Sheets("Devis").Cells(4, "B").Offset(, DerCol - 1)
Range("TAB_Cat[#All]").Copy Sheets("Devis").Cells(4, "D").Offset(, DerCol - 1)
Next
End Sub
 
Vote positif 0 Vote négatif
T

Terreur

XLDnaute Nouveau
Bonjour Yurperqod,

Merci de ton aide. J'ai essayé ta solution mais j'ai un code erreur 1004 "La méthode Clear de la classe Range a échoué." qui se produit au niveau de la déclaration des tableaux. Je ne vois malheureusement pas sur quoi cela bloque.

Merci de votre aide le forum.
 
Vote positif 0 Vote négatif

Yurperqod

XLDnaute Occasionnel
Bonjour le forum, bonjour Terreur

Terreur
J'ai testé sur ton fichier Excel sans erreur
Tu as bien nommé les tableaux comme j'ai fait ?

Comme je lance la macro, pour l'instant ca copie les tableaux
 
Vote positif 0 Vote négatif

Yurperqod

XLDnaute Occasionnel
Il faut d'abord utiliser la fonction Tableau
(Insertion/Tableau) puis ensuite renommer les tableaux
Regarde ma copie d'écran et dans le gestionnaire de noms de ton Excel, on voit que les icones ne sont pas les mêmes

Voici la suite de mes tests
VB: 
Sub Creation_Tableaux_V3()
Dim DerCol As Long
Dim i As Long
Sheets("Devis").Cells.Clear
For i = 7 To 12
If Sheets("Produits").Cells(i, "F") Then
DerCol = Sheets("Devis").Cells(4, Columns.Count).End(xlToLeft).Column
Range("TAB_Taille[#All]").Copy Sheets("Devis").Cells(4, "B").Offset(, DerCol - 1)
Range("TAB_Cat[#All]").Copy Sheets("Devis").Cells(4, "D").Offset(, DerCol - 1)
End If
Next
End Sub
Voila ce qu'on doit voir une fois corrigé en utilisant les Tableaux Excel

Je viens de modifier sur ton dernier fichier EXCEL et il n'y a plus de message d'erreur.
 
Dernière édition:
Vote positif 0 Vote négatif
T

Terreur

XLDnaute Nouveau
Merci Yurperqod ! Ca marche ! Par contre par rapport à ma contrainte cela copie les deux tableau systématiquement alors que je ne voudrais que le TAB_Cat qui se copie plusieurs fois en fonction du nombre de cases =)
 
Vote positif 0 Vote négatif

Yurperqod

XLDnaute Occasionnel
Suite de mes tests
VB: 
Sub Creation_Tableaux_V4()
Dim i As Long
Dim DebutCellule
DebutCellule = Array(4, 7, 10, 13, 16, 19)
Sheets("Devis").Cells.Clear
Range("TAB_Taille[#All]").Copy Sheets("Devis").Cells(4, "B")
For i = 7 To 12
If Sheets("Produits").Cells(i, "F") Then
Range("TAB_Cat[#All]").Copy Sheets("Devis").Cells(4, DebutCellule(i - 7))
'Pour faire des tests
Sheets("Devis").Cells(3, DebutCellule(i - 7)) = "Produits" & i
End If
Next
End Sub
Je continue à chercher comment récupérer le noms des produits dans les cases à cocher de la feuille Produits .
 
Vote positif 0 Vote négatif

Yurperqod

XLDnaute Occasionnel
Voila j'ai trouvé comment copier le nom des produits
VB: 
Sub Creation_Tableaux_V5()
Dim cb As CheckBox
Dim i As Long
Dim DebutCellule
DebutCellule = Array(4, 7, 10, 13, 16, 19)
i = 7
Sheets("Devis").Cells.Clear
Range("TAB_Taille[#All]").Copy Sheets("Devis").Cells(4, "B")
For Each cb In Sheets("Produits").CheckBoxes
If cb.Value = xlOn Then
Range("TAB_Cat[#All]").Copy Sheets("Devis").Cells(4, DebutCellule(i - 7))
Sheets("Devis").Cells(3, DebutCellule(i - 7)) = cb.Caption
i = i + 1
End If
Next cb
End Sub
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

G
  • Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
173
sylvanu
J
  • Question
Microsoft 365 VBA et mise en forme conditionel
Réponses
2
Affichages
340
jalaba
J
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
426
ph.vanne
E
  • Résolu(e)
Microsoft 365 Copier Coller selon condition
Réponses
5
Affichages
222
TooFatBoy
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
540
marie3107
M
3
  • Question
XL 2010 Copier un tableau croisé dynamique même si celui ci a un nombre de ligne variable
Réponses
4
Affichages
689
306255
3
  • Question
Microsoft 365 Variable tableau : coller uniquement une partie des colonnes
2 3
Réponses
31
Affichages
1 K
BenHarber
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
1 K
job75
  • Question
XL 2019 Détecter les valeurs suivant les tableaux sélectionnés et, si elles sont non-existantes, les copier
2 3
Réponses
33
Affichages
1 K
Amigo
J
  • Résolu(e)
XL 2019 Détection de texte dans une Cellule pour le Copier et Coller dans un autre tableau
2 3
Réponses
40
Affichages
1 K
Phil69970
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…