Envoie de données suivant Choix

[GClaire]

Bonjour a toutes et tous.

J'espère que vous allez bien.

Je suis sur un petit fichier pour un ami.

La première partie est fini, la création des clients.

A partir de la base créée, mon ami voudrai après avoir fait un choix (Peut lui importe le moyen) pouvoir envoyé les sélections choisies dans une autre feuille, faire en même temps le formatage des bordures au fur et a mesure.

(Celle-ci sera ensuite complétée pour qu'il sache ce que chaque client doit recevoir.)

Cette sélection est des plus simple, un "1" mis devant chaque client en colonne B "Livraison".

Pour faire l'envoie je passe par une macro que j'ai trouvé dans le forum fait par CLAUDY, que j'ai tenté d'adapter qui est dans le module "Mdl_Validation_Livraison".

je pensais que mes adaptations étaient bonnes mais je me rend compte que tout n'est soit :

1) Pas a sa place
2) inéxistant ou perte de données.

Je me suis arraché les cheveux (Suis chauve maintenant) toute l'aprés midi, en vain.

je vous remercie par avance de votre aide.

Cordialement, jacques

 

[sousou]

bonjour
remplace comme ceci
With Sheets("Livraisons")

drlg = .Cells(.UsedRange.Columns(1).Rows.Count, 1).End(xlUp).Row + 1
.Cells(drlg, 1) = cel.Offset(0, 1).Value 'Nom
.Cells(drlg, 2) = cel.Offset(0, 2).Value 'Prénom
.Cells(drlg, 3) = cel.Offset(0, 3).Value 'Portable
.Cells(drlg, 4) = cel.Offset(0, 4).Value 'Fixe
.Cells(drlg, 5) = cel.Offset(0, 5).Value 'E-Mail
.Cells(drlg, 6) = cel.Offset(0, 6).Value 'N° Rue
.Cells(drlg, 7) = cel.Offset(0, 7).Value 'Rue
.Cells(drlg, 8) = cel.Offset(0, 8).Value 'Batiment
.Cells(drlg, 9) = cel.Offset(0, 9).Value 'Etage
.Cells(drlg, 10) = cel.Offset(0, 10).Value 'Code Postal
.Cells(drlg, 11) = cel.Offset(0, 11).Value 'Ville
.Cells(drlg, 12) = cel.Offset(0, 12).Value 'Remarque
End With
End If
Next

 

[GClaire]

Bonjour SouSou, le forum

Merci pour ta réponse.

Voici le code de la procédure ainsi modifiée.

Sub Validation_Livraisons()
'
' Macro1 Macro
' 24/03/2020
derlg = Range("B5000").End(xlUp).Row
With Sheets("Livraisons")
.Range("A2:L100").ClearContents
End With
For Each cel In Range("B2:B" & derlg)
If cel.Value = 1 Then
With Sheets("Livraisons")
drlg = .Cells(.UsedRange.Columns(1).Rows.Count, 1).End(xlUp).Row + 1
.Cells(drlg, 1) = cel.Offset(0, 1).Value 'Nom
.Cells(drlg, 2) = cel.Offset(0, 2).Value 'Pr?nom
.Cells(drlg, 3) = cel.Offset(0, 3).Value 'Portable
.Cells(drlg, 4) = cel.Offset(0, 4).Value 'Fixe
.Cells(drlg, 5) = cel.Offset(0, 5).Value 'E-Mail
.Cells(drlg, 6) = cel.Offset(0, 6).Value 'N? Rue
.Cells(drlg, 7) = cel.Offset(0, 7).Value 'Rue
.Cells(drlg, 8) = cel.Offset(0, 8).Value 'Batiment
.Cells(drlg, 9) = cel.Offset(0, 9).Value 'Etage
.Cells(drlg, 10) = cel.Offset(0, 10).Value 'Code Postal
.Cells(drlg, 11) = cel.Offset(0, 11).Value 'Ville
.Cells(drlg, 12) = cel.Offset(0, 12).Value 'Remarque
End With
End If
Next
'Application.ScreenUpdating = True
'Formatage_Bordures
'Application.ScreenUpdating = False
End Sub

Cela me créer une seule ligne dans la feuille "Livraison".

En faite en mode pas a pas, je vois bien que la ligne qui arrive, écrase celle d'avant.

Je continue de regarder.

Merci, beaucoup.

 

[sousou]

Re
Oublier un +1 dans calcul drlg
Sub Validation_Livraisons()
'
' Jacques le 24/03/2020
derlig = Range("B5000").End(xlUp).Row
With Sheets("Livraisons")
.Range("A2:L100").ClearContents
End With
For Each cel In Range("B2:B" & derlig)
If cel.Value = 1 Then
With Sheets("Livraisons")

drlg = .Cells(.UsedRange.Columns(1).Rows.Count + 1, 1).End(xlUp).Row + 1
.Cells(drlg, 1) = cel.Offset(0, 1).Value 'Nom
.Cells(drlg, 2) = cel.Offset(0, 2).Value 'Prénom
.Cells(drlg, 3) = cel.Offset(0, 3).Value 'Portable
.Cells(drlg, 4) = cel.Offset(0, 4).Value 'Fixe
.Cells(drlg, 5) = cel.Offset(0, 5).Value 'E-Mail
.Cells(drlg, 6) = cel.Offset(0, 6).Value 'N° Rue
.Cells(drlg, 7) = cel.Offset(0, 7).Value 'Rue
.Cells(drlg, 8) = cel.Offset(0, 8).Value 'Batiment
.Cells(drlg, 9) = cel.Offset(0, 9).Value 'Etage
.Cells(drlg, 10) = cel.Offset(0, 10).Value 'Code Postal
.Cells(drlg, 11) = cel.Offset(0, 11).Value 'Ville
.Cells(drlg, 12) = cel.Offset(0, 12).Value 'Remarque
End With
End If
Next


Application.ScreenUpdating = True

Formatage_Bordures

Application.ScreenUpdating = False

End Sub

 

[GClaire]

Hello Sousou, le forum.

Merci.

Modifié.

C'est OK, good.

Bon je vais rajouter un test (Qu(il faut que sur la plage, il y ait au moins une cellule non vide , car sinon elle plante.

Bon j'avance sur le formatage.

Il fonctionne mais j'ai dû jouer d'une bidouille car sinon j'arrivais a prêt de 500 feuilles a imprimer.

Merci encore.

cordialement, G'Claire