Copie tableau et mise en forme

[TIGER]

Bonsoir le forum

Je souhaite donc recopier un ou plusieurs tableaux variable "offres de prix" vers un onglet "courrier offre de prix".

Ci-joint le tableau pour beaucoup plus de clarté.

Merci d'avance et longue vie au forum

 

[porcinet82]

Re : Copie tableau et mise en forme

Salut Tiger,

Une première approche par ce petit bout de code, mais je pense qu'il y a quelques modif a apporter afin que ce vraiment automatique

Sub test()
Dim i%
Application.Goto Sheets("RecupDonnées").Range("A1")
'plage de cellule correspondant au max de tes 3 tableaux
With Sheets("OffreDePrix")
    .Select
    .Rows("21:48").Insert Shift:=xlDown
    .Cells(21, 1).Select
    Sheets("RecupDonnées").Range("C2:F29").Copy
    ActiveSheet.Paste
End With
For i = 48 To 21 Step -1
    If IsEmpty(Cells(i, 1).Value) Then
        If Not Left(Cells(i + 1, 1).Value, 7) = "produit" Then
            Rows(i).Delete
        End If
    End If
Next i
End Sub

Pour que le code fonctionne, il fauut que dans ta feuille OffreDePrix, tu ne laisses que 2 lignes vides entre Suite à notre entretien, j'ai le plaisir de vous proposer nos conditions de prix pour la fourniture des produits suivants : et N’hésitez surtout pas à me contacter pour tous renseignements supplémentaires.

Modif éventuelle a apporter :

• Automatiser la plage de cellule, mais il faudrait savoir si il y a des données sous tes tableaux de la feuille RecupDonnées.
• Supprimer un tableau si il est vide (dans ton exemple le tableau 2) si ca peut arriver

Tiens moi au courant,

@+

 

[TIGER]

Re : Copie tableau et mise en forme

Merci porcinet82, j'essaye ça ce matin et je te donne le résultat au + vite.

 

[TIGER]

Re : Copie tableau et mise en forme

porcinet82, le forum,

La première partie fonctionne très bien, merci !

Il reste donc 2 points :

1/ Supprimer le(s) tableau(x) n'ayant pas de valeur mais il faut le faire dans la partie "OffreDePrix" car la partie "RecupDonnées" évolue et on ne peut modifier la stucuture des tableaux dans cet onglet.

2/ En vue des autres offres de prix, créer une 2nd macro qui supprimera toute la partie entre les 2 paragraphes dans la partie "OffreDePrix" (cad les tableaux que l'on aura inséré via la première macro) et ne laisser que 2 lignes entre les 2 paragraphes de manière à pouvoir relancer la première macro

Pour répondre à tes questions :

"Automatiser la plage de cellule, mais il faudrait savoir si il y a des données sous tes tableaux de la feuille RecupDonnées."

Il n'y a pas de valeur sous les tableaux mais nous ne pouvons toucher à la structure car ses valeurs sont mises à jour via d'autres macro

"Supprimer un tableau si il est vide (dans ton exemple le tableau 2) si ca peut arriver"

Ca peut arriver en effet et cela, sur nimporte quel tableau.

Merci encore pour votre aide si précieuse

 

[TIGER]

Re : Copie tableau et mise en forme

Au fait, question de débutant, dois-je créer un post par problème ou cette demande convient ?

 

[porcinet82]

Re : Copie tableau et mise en forme

Salut Tiger,

Tant que tu as sur le meme problème, ou plutot le meme fichier comme c'est le cas ici, pas besoin de créer un nouveau fil, de cette manière, les personnes qui suivent le fil n'ont pas de mal a s'y retrouver.

Sinon je t'ai préparer un nouveau bout de code que je vais te laisser tester a fond et me dire ce que tu en penses.

Sub test()
Dim i%, der_lig%, max_lig%
Application.ScreenUpdating = False
Application.Goto Sheets("RecupDonnées").Range("A1")
max_lig = Range("C65536").End(xlUp).Row
With Sheets("OffreDePrix")
    .Select
    'avant la suppression on test pour savoir s'il y a au moins un tableau
    If Left(.Range("A21").Value, 7) = "produit" Then
        der_lig = .Range("A65536").End(xlUp).Row - 2
        .Rows("21:" & der_lig).Delete
    End If
    .Rows("21:" & 21 + max_lig - 2).Insert Shift:=xlDown
    .Cells(21, 1).Select
    Sheets("RecupDonnées").Range("C2:F" & max_lig).Copy
    ActiveSheet.Paste
End With
For i = max_lig + 19 To 21 Step -1
    If IsEmpty(Cells(i, 1).Value) Then
        If Not Left(Cells(i + 1, 1).Value, 7) = "produit" Then
            Rows(i).Delete
        End If
    End If
Next i
'on supprime les tableaux vides
For i = max_lig + 19 To 21 Step -1
    If Left(Cells(i, 1).Value, 7) = "produit" Then
        If IsEmpty(Cells(i + 2, 1).Value) Then
            Rows(i + 1).Delete
            Rows(i).Delete
        End If
    End If
Next i
Application.ScreenUpdating = True
End Sub

Tiens moi au courant,

@+

 

[TIGER]

Re : Copie tableau et mise en forme

Bonsoir porcinet82, le forum,

C'est fantastique, tout marche à la perfection ! (ci-joint le résultat)
Encore une fois merci porcinet82.
A moi maintenant de l'adapter aux nombres de cellule de mon vrai tableau.

Je pense que j'abuse mais j'ai une dernière question : Dans un soucis de mise en page, étant donné que le nombre et la taille des tableaux sont variable, est-ce possible de faire en sorte que toute la partie courrier, sans les en-têtes, soit centré sur la page (de "Monsieur," à la signature)

Te remerciant à nouveau.

Ps : tu pourrais presque faire un tuto dans la rubrique pro concernant l'intégration de tableaux variable dans un courrier excel en vue d'une offre de prix par exemple.

 

[porcinet82]

Re : Copie tableau et mise en forme

Salut Tiger,

Je t'ai préparé un petit bout de code pour tenter de centrer tes données, regardes si ca te convient, sachant que comme tu as des cellules fusionnées ca merdouille un peu. Est-ce nque tu pourrais modifier un peu ton fichier pout éviter les cellules fusionnées ?

Sinon j'essaierai d'apporter une modif au code pour que ca refusionne les cellules apres la centrage. Et dis moi si les données telles qu'elles sont centrées, ca te convient.

@+

 

[porcinet82]

Re : Copie tableau et mise en forme

Oups..., le code :

Sub test_v3()
Dim i%, der_lig%, max_lig%, deb%, fin%
Dim cel As Range
Application.ScreenUpdating = False
Application.Goto Sheets("RecupDonnées").Range("A1")
max_lig = Range("C65536").End(xlUp).Row
With Sheets("OffreDePrix")
.Select
'avant la suppression on test pour savoir s'il y a au moins un tableau
For Each cel In Range("A21:G50")
If Left(cel.Value, 7) = "produit" Then
der_lig = .Range("A65536").End(xlUp).Row
.Rows(cel.Row - 7 & ":" & der_lig).Delete
 
Range("C14").Value = "Monsieur,"
Range("A17").Value = " Suite à notre entretien, j'ai le plaisir de vous proposer nos conditions de prix pour la fourniture des produits suivants : "
Range("A20").Value = "N’hésitez surtout pas à me contacter pour tous renseignements supplémentaires."
Exit For
End If
Next cel
.Rows("19:" & 21 + max_lig - 2).Insert Shift:=xlDown
.Cells(19, 2).Select
Sheets("RecupDonnées").Range("C2:F" & max_lig).Copy
ActiveSheet.Paste
End With
For i = max_lig + 19 To 21 Step -1
If IsEmpty(Cells(i, 2).Value) Then
If Not Left(Cells(i + 1, 2).Value, 7) = "produit" Then
Rows(i).Delete
End If
End If
Next i
'on supprime les tableaux vides
For i = max_lig + 19 To 21 Step -1
If Left(Cells(i, 2).Value, 7) = "produit" Then
If IsEmpty(Cells(i + 2, 2).Value) Then
Rows(i + 1).Delete
Rows(i).Delete
End If
End If
Next i
'centrage des données
der_lig = Range("A65536").End(xlUp).Row
Rows("14:" & der_lig + 4).Select
deb = 14 + Int((50 - (der_lig + 4)) / 2)
fin = der_lig + 4 + Int((50 - (der_lig + 4)) / 2)
Application.DisplayAlerts = False
Selection.Cut Destination:=Rows(deb & ":" & fin)
Application.DisplayAlerts = True
ActiveSheet.PageSetup.PrintArea = "A1:G50"
Application.ScreenUpdating = True
End Sub

@+

 

[TIGER]

Re : Copie tableau et mise en forme

Bonjour porcinet82, le forum,

J'ai entré ce code :

-----------------------------------------

Sub test2()
Dim i%, der_lig%, max_lig%
Application.ScreenUpdating = False
Application.Goto Sheets("RecupDonnées").Range("A1")
max_lig = Range("C65536").End(xlUp).Row
With Sheets("OffreDePrix")
.Select
'avant la suppression on test pour savoir s'il y a au moins un tableau
If Left(.Range("A21").Value, 7) = "produit" Then
der_lig = .Range("A65536").End(xlUp).Row - 2
.Rows("21:" & der_lig).Delete
End If
.Rows("21:" & 21 + max_lig - 2).Insert Shift:=xlDown
.Cells(21, 1).Select
Sheets("RecupDonnées").Range("C2:F" & max_lig).Copy
ActiveSheet.Paste
End With
For i = max_lig + 19 To 21 Step -1
If IsEmpty(Cells(i, 1).Value) Then
If Not Left(Cells(i + 1, 1).Value, 7) = "produit" Then
Rows(i).Delete
End If
End If
Next i
'on supprime les tableaux vides
For i = max_lig + 19 To 21 Step -1
If Left(Cells(i, 1).Value, 7) = "produit" Then
If IsEmpty(Cells(i + 2, 1).Value) Then
Rows(i + 1).Delete
Rows(i).Delete
End If
End If
Next i
Application.ScreenUpdating = True

'centrage des données
der_lig = Range("A65536").End(xlUp).Row
Rows("14:" & der_lig + 4).Select
deb = 14 + Int((50 - (der_lig + 4)) / 2)
fin = der_lig + 4 + Int((50 - (der_lig + 4)) / 2)
Application.DisplayAlerts = False
Selection.Cut Destination:=Rows(deb & ":" & fin)
Application.DisplayAlerts = True
ActiveSheet.PageSetup.PrintArea = "A1:G50"
Application.ScreenUpdating = True
End Sub

-----------------------------------------

Qui est un mix des 2 derniers mais qui a l'avantage d'accepter les cellules fusionnées.

Le problème étant qu'il faudrait, comme tu le faisais remarqué, re-fusionné les cellules une fois toutes les opérations terminées.

Pour ce qui est de la remise en forme en vue d'une nouvelle offre, je pense créer une feuille type sans tableau et remplacer "OffreDePrix" par celle-ci avant de lancer la macro.

Bonne soirée et merci,

Nico

 

[porcinet82]

Re : Copie tableau et mise en forme

Salut Tiger,

Alors ca fonctionne comme tu le souhaites ou pas? Est-ce qu'il faut apporter des modif?
Si tu as un soucis n'hesite pas a refaire signe. En attendant, bon week,

@+

 

[TIGER]

Re : Copie tableau et mise en forme

Bonsoir porcinet82, le forum,

Désolé pour la réponse tardive mais j'essayé d'y arrivé par mes propres moyen cependant...

J'ai encore un problème avec ce code :

- Il faut que je refusionne et mette en forme (retour à la ligne automatique et position gauche) mais les 2 lignes à fusionner ne sont jamais à la même place

Voir le fichier joint.

Merci d'avance