Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

creation d'une macro par Daniel.C

13 réponses
Avatar
Cyr13
bonjour
ce message suite au code de Daniel.C
suite au test de la macro j ai decouvert un probleme
tout fonctionne bien pour le premier client mais on dirait qu elle plantedes
le deuxieme(probleme de boucle ??)
merci de l aide !!
ci joint le code que j ai adapter

Sub Imprimer_Feuille_Livraison()

rep = InputBox("Entrez une date")
If IsDate(rep) Then
rep = CDate(rep)
With Sheets("effectifs clients")
col = Application.Match(rep * 1, .[C4:AG4], 0)
If IsNumeric(col) Then
col = col + 2
ligne = Intersect(.Columns(col), .Rows("5:60000")).Find("*").Row
On Error Resume Next
Feuille = .Cells(ligne, 2)
Sheets(Feuille).[J11:K11].Select
Sheets(Feuille).AutoFilter
Sheets(Feuille).AutoFilter Field:=2, Criteria1:="<>"
Attente (500)
Sheets(Feuille).PrintOut
Sheets(Feuille).AutoFilter
Attente (500)
If Err.Number <> 0 Then
Err.Clear
MsgBox "L'onglet de ce client n'existe Pas !!" & .Cells(ligne,
1)
End If
End If
End With
End If
End Sub
-------------------------------------------------------
Sub Attente(milisecond As Integer)
Dim Start, PauseTime
PauseTime = milisecond / 7200
Start = Timer
Do While Timer < Start + PauseTime
DoEvents
Loop
End Sub

3 réponses

1 2
Avatar
Cyr13
bonsoir Daniel.C
vraiment désolé j' ai oublier de te dire qu il fallait prendre le feuille
existante "Trame" ,la copier et lui donner le nom du client B6:B45 sur la
feuille "effectifs Clients"
encore merci de ta gentillesse

"Daniel.C" a écrit dans le message de news:

Bonsoir.
Essaie :

Sub CreerFeuilles()
Dim c As Range
For Each c In ['effectifs clients'!B6:B45]
If c <> "" Then
Sheets.Add.Name = c.Value
[E12] = c.Value
End If
Next c
End Sub

Cordialement.
Daniel
"Cyr13" a écrit dans le message de news:
%

bonsoir Daniel.C
que dire sinon que tu es formidable cela marche impecable.
pour le filtre j ai juste changer le critere <> par 1

ps: puis-je abuser encore de tes connaissances en te demandant si il est
possible qu une macro ajoute les onglets elle meme en prenant le nom des
clients sur la feuille "effectifs clients"de B6:B45 et qu elle colle se
nom en cellule E12 sur chaque onglets qu elle ajoute







Avatar
Daniel.C
Bonsoir.
Essaie (non testé) :

Sub CreerFeuilles()
Dim c As Range
For Each c In ['effectifs clients'!B6:B45]
If c <> "" Then
Sheets("Trame").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name c.Value
[E12] = c.Value
End If
Next c
End Sub

Daniel
"Cyr13" a écrit dans le message de news:

bonsoir Daniel.C
vraiment désolé j' ai oublier de te dire qu il fallait prendre le feuille
existante "Trame" ,la copier et lui donner le nom du client B6:B45 sur la
feuille "effectifs Clients"
encore merci de ta gentillesse

"Daniel.C" a écrit dans le message de news:

Bonsoir.
Essaie :

Sub CreerFeuilles()
Dim c As Range
For Each c In ['effectifs clients'!B6:B45]
If c <> "" Then
Sheets.Add.Name = c.Value
[E12] = c.Value
End If
Next c
End Sub

Cordialement.
Daniel
"Cyr13" a écrit dans le message de news:
%

bonsoir Daniel.C
que dire sinon que tu es formidable cela marche impecable.
pour le filtre j ai juste changer le critere <> par 1

ps: puis-je abuser encore de tes connaissances en te demandant si il est
possible qu une macro ajoute les onglets elle meme en prenant le nom des
clients sur la feuille "effectifs clients"de B6:B45 et qu elle colle se
nom en cellule E12 sur chaque onglets qu elle ajoute











Avatar
Cyr13
bonsoir
encore merci Daniel.C pour cette aide précieuse
tout fonctionne parfaitement.merci
1 2