Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Macro à creer

Macro à creer

11 réponses
Avatar
alain.bazire
Bonsoir a toutes et a tous .Qui pourrait m'aider a construire une macro de
facons que je n'ai pas a recopier 8 fois la meme chose SVPmerci de bien
m'aider.Amitiées.Alain
Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
"ce qui est dessous est augmene de 1 pour criteria,rangeC1et rangeL1

Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Daniel
Bonsoir.
Si j'ai bien compris, essaie :

For i = 1 To 5
If i <> 4 Then
Sheets("Feuil" & i).Select
Selection.AutoFilter Field:=1, Criteria1:="117"
End If
Next i

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

Bonsoir a toutes et a tous .Qui pourrait m'aider a construire une macro de
facons que je n'ai pas a recopier 8 fois la meme chose SVPmerci de bien
m'aider.Amitiées.Alain
Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
"ce qui est dessous est augmene de 1 pour criteria,rangeC1et rangeL1

Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True



Avatar
alain.bazire
Bonsoir Daniel mais je voudrais que cela continue plusieurs fois et que cela
me copie comme je le fais dans mon semblant de macro Merci d'avance; Je colle
cela a quel endroit de ma macro tu vois je n' y connais rien


Bonsoir.
Si j'ai bien compris, essaie :

For i = 1 To 5
If i <> 4 Then
Sheets("Feuil" & i).Select
Selection.AutoFilter Field:=1, Criteria1:="117"
End If
Next i

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

Bonsoir a toutes et a tous .Qui pourrait m'aider a construire une macro de
facons que je n'ai pas a recopier 8 fois la meme chose SVPmerci de bien
m'aider.Amitiées.Alain
Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
"ce qui est dessous est augmene de 1 pour criteria,rangeC1et rangeL1

Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True








Avatar
Daniel
Teste ça :

Sub Test()
Dim i As Integer, j As Integer
For i = 1 To 8
For j = 1 To 5
If j <> 4 Then
Sheets("Feuil" & j).Select
Selection.AutoFilter Field:=1, Criteria1:6 + i
End If
Next j
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Next i
End Sub

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

Bonsoir Daniel mais je voudrais que cela continue plusieurs fois et que
cela
me copie comme je le fais dans mon semblant de macro Merci d'avance; Je
colle
cela a quel endroit de ma macro tu vois je n' y connais rien


Bonsoir.
Si j'ai bien compris, essaie :

For i = 1 To 5
If i <> 4 Then
Sheets("Feuil" & i).Select
Selection.AutoFilter Field:=1, Criteria1:="117"
End If
Next i

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

Bonsoir a toutes et a tous .Qui pourrait m'aider a construire une macro
de
facons que je n'ai pas a recopier 8 fois la meme chose SVPmerci de bien
m'aider.Amitiées.Alain
Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
"ce qui est dessous est augmene de 1 pour criteria,rangeC1et rangeL1

Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True










Avatar
alain.bazire
Quand je copie ca il met tout en rouge il surligne la 1ere ligne et dit
erreur de syntaxe ou ca commence par dim


Teste ça :

Sub Test()
Dim i As Integer, j As Integer
For i = 1 To 8
For j = 1 To 5
If j <> 4 Then
Sheets("Feuil" & j).Select
Selection.AutoFilter Field:=1, Criteria1:6 + i
End If
Next j
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Next i
End Sub

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

Bonsoir Daniel mais je voudrais que cela continue plusieurs fois et que
cela
me copie comme je le fais dans mon semblant de macro Merci d'avance; Je
colle
cela a quel endroit de ma macro tu vois je n' y connais rien


Bonsoir.
Si j'ai bien compris, essaie :

For i = 1 To 5
If i <> 4 Then
Sheets("Feuil" & i).Select
Selection.AutoFilter Field:=1, Criteria1:="117"
End If
Next i

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

Bonsoir a toutes et a tous .Qui pourrait m'aider a construire une macro
de
facons que je n'ai pas a recopier 8 fois la meme chose SVPmerci de bien
m'aider.Amitiées.Alain
Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
"ce qui est dessous est augmene de 1 pour criteria,rangeC1et rangeL1

Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True















Avatar
Daniel
Je ne vois pas pourquoi. Si ton classeur ne contient pas de données
confidentielles, fais-le suivre en utilisant l'adresse http://www.cjoint.com
Daniel
"" a
écrit dans le message de news:

Quand je copie ca il met tout en rouge il surligne la 1ere ligne et dit
erreur de syntaxe ou ca commence par dim


Teste ça :

Sub Test()
Dim i As Integer, j As Integer
For i = 1 To 8
For j = 1 To 5
If j <> 4 Then
Sheets("Feuil" & j).Select
Selection.AutoFilter Field:=1, Criteria1:6 + i
End If
Next j
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Next i
End Sub

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

Bonsoir Daniel mais je voudrais que cela continue plusieurs fois et que
cela
me copie comme je le fais dans mon semblant de macro Merci d'avance; Je
colle
cela a quel endroit de ma macro tu vois je n' y connais rien


Bonsoir.
Si j'ai bien compris, essaie :

For i = 1 To 5
If i <> 4 Then
Sheets("Feuil" & i).Select
Selection.AutoFilter Field:=1, Criteria1:="117"
End If
Next i

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

Bonsoir a toutes et a tous .Qui pourrait m'aider a construire une
macro
de
facons que je n'ai pas a recopier 8 fois la meme chose SVPmerci de
bien
m'aider.Amitiées.Alain
Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
"ce qui est dessous est augmene de 1 pour criteria,rangeC1et rangeL1

Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True

















Avatar
alain.bazire
Mon fichier meme compresse fait 6mo j'enleve les feuilles 2 3 5 mais le
contenu est le meme que la 1 sur 6500lignes a peu pres


Je ne vois pas pourquoi. Si ton classeur ne contient pas de données
confidentielles, fais-le suivre en utilisant l'adresse http://www.cjoint.com
Daniel
"" a
écrit dans le message de news:

Quand je copie ca il met tout en rouge il surligne la 1ere ligne et dit
erreur de syntaxe ou ca commence par dim


Teste ça :

Sub Test()
Dim i As Integer, j As Integer
For i = 1 To 8
For j = 1 To 5
If j <> 4 Then
Sheets("Feuil" & j).Select
Selection.AutoFilter Field:=1, Criteria1:6 + i
End If
Next j
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Next i
End Sub

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

Bonsoir Daniel mais je voudrais que cela continue plusieurs fois et que
cela
me copie comme je le fais dans mon semblant de macro Merci d'avance; Je
colle
cela a quel endroit de ma macro tu vois je n' y connais rien


Bonsoir.
Si j'ai bien compris, essaie :

For i = 1 To 5
If i <> 4 Then
Sheets("Feuil" & i).Select
Selection.AutoFilter Field:=1, Criteria1:="117"
End If
Next i

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

Bonsoir a toutes et a tous .Qui pourrait m'aider a construire une
macro
de
facons que je n'ai pas a recopier 8 fois la meme chose SVPmerci de
bien
m'aider.Amitiées.Alain
Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
"ce qui est dessous est augmene de 1 pour criteria,rangeC1et rangeL1

Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True






















Avatar
Daniel
Tu peux, si tu le souhaites l'envoyer à mon adresse :
(enlève les Z)
Daniel
"" a
écrit dans le message de news:

Mon fichier meme compresse fait 6mo j'enleve les feuilles 2 3 5 mais le
contenu est le meme que la 1 sur 6500lignes a peu pres


Je ne vois pas pourquoi. Si ton classeur ne contient pas de données
confidentielles, fais-le suivre en utilisant l'adresse
http://www.cjoint.com
Daniel
""
a
écrit dans le message de news:

Quand je copie ca il met tout en rouge il surligne la 1ere ligne et dit
erreur de syntaxe ou ca commence par dim


Teste ça :

Sub Test()
Dim i As Integer, j As Integer
For i = 1 To 8
For j = 1 To 5
If j <> 4 Then
Sheets("Feuil" & j).Select
Selection.AutoFilter Field:=1, Criteria1:6 + i
End If
Next j
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Next i
End Sub

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

Bonsoir Daniel mais je voudrais que cela continue plusieurs fois et
que
cela
me copie comme je le fais dans mon semblant de macro Merci d'avance;
Je
colle
cela a quel endroit de ma macro tu vois je n' y connais rien


Bonsoir.
Si j'ai bien compris, essaie :

For i = 1 To 5
If i <> 4 Then
Sheets("Feuil" & i).Select
Selection.AutoFilter Field:=1, Criteria1:="117"
End If
Next i

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

Bonsoir a toutes et a tous .Qui pourrait m'aider a construire une
macro
de
facons que je n'ai pas a recopier 8 fois la meme chose SVPmerci
de
bien
m'aider.Amitiées.Alain
Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
"ce qui est dessous est augmene de 1 pour criteria,rangeC1et
rangeL1

Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
























Avatar
alain.bazire
Voila je l'ai envoye mais oblige de supprimer feuil 2 3 5 dont le contenu est
identique a la 1 donc tu peux en rajouter avec le meme contenu sinon meme
zippe il depassait les 250Mo je te remercie de t'occuper si chaleureusement
de moi.Merci.Amitiées.Alain


Je ne vois pas pourquoi. Si ton classeur ne contient pas de données
confidentielles, fais-le suivre en utilisant l'adresse http://www.cjoint.com
Daniel
"" a
écrit dans le message de news:

Quand je copie ca il met tout en rouge il surligne la 1ere ligne et dit
erreur de syntaxe ou ca commence par dim


Teste ça :

Sub Test()
Dim i As Integer, j As Integer
For i = 1 To 8
For j = 1 To 5
If j <> 4 Then
Sheets("Feuil" & j).Select
Selection.AutoFilter Field:=1, Criteria1:6 + i
End If
Next j
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Next i
End Sub

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

Bonsoir Daniel mais je voudrais que cela continue plusieurs fois et que
cela
me copie comme je le fais dans mon semblant de macro Merci d'avance; Je
colle
cela a quel endroit de ma macro tu vois je n' y connais rien


Bonsoir.
Si j'ai bien compris, essaie :

For i = 1 To 5
If i <> 4 Then
Sheets("Feuil" & i).Select
Selection.AutoFilter Field:=1, Criteria1:="117"
End If
Next i

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

Bonsoir a toutes et a tous .Qui pourrait m'aider a construire une
macro
de
facons que je n'ai pas a recopier 8 fois la meme chose SVPmerci de
bien
m'aider.Amitiées.Alain
Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
"ce qui est dessous est augmene de 1 pour criteria,rangeC1et rangeL1

Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True






















Avatar
alain.bazire
je n'ai pas mis ton nom sur cjoint le fichier s'apelle Rapido comptage
tirage 5


Je ne vois pas pourquoi. Si ton classeur ne contient pas de données
confidentielles, fais-le suivre en utilisant l'adresse http://www.cjoint.com
Daniel
"" a
écrit dans le message de news:

Quand je copie ca il met tout en rouge il surligne la 1ere ligne et dit
erreur de syntaxe ou ca commence par dim


Teste ça :

Sub Test()
Dim i As Integer, j As Integer
For i = 1 To 8
For j = 1 To 5
If j <> 4 Then
Sheets("Feuil" & j).Select
Selection.AutoFilter Field:=1, Criteria1:6 + i
End If
Next j
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Next i
End Sub

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

Bonsoir Daniel mais je voudrais que cela continue plusieurs fois et que
cela
me copie comme je le fais dans mon semblant de macro Merci d'avance; Je
colle
cela a quel endroit de ma macro tu vois je n' y connais rien


Bonsoir.
Si j'ai bien compris, essaie :

For i = 1 To 5
If i <> 4 Then
Sheets("Feuil" & i).Select
Selection.AutoFilter Field:=1, Criteria1:="117"
End If
Next i

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

Bonsoir a toutes et a tous .Qui pourrait m'aider a construire une
macro
de
facons que je n'ai pas a recopier 8 fois la meme chose SVPmerci de
bien
m'aider.Amitiées.Alain
Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
"ce qui est dessous est augmene de 1 pour criteria,rangeC1et rangeL1

Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True






















Avatar
Daniel
Tu dois indiquer l'adresse générée par www.cjoint.com (par copier / coller)
Daniel
"" a
écrit dans le message de news:

je n'ai pas mis ton nom sur cjoint le fichier s'apelle Rapido comptage
tirage 5


Je ne vois pas pourquoi. Si ton classeur ne contient pas de données
confidentielles, fais-le suivre en utilisant l'adresse
http://www.cjoint.com
Daniel
""
a
écrit dans le message de news:

Quand je copie ca il met tout en rouge il surligne la 1ere ligne et dit
erreur de syntaxe ou ca commence par dim


Teste ça :

Sub Test()
Dim i As Integer, j As Integer
For i = 1 To 8
For j = 1 To 5
If j <> 4 Then
Sheets("Feuil" & j).Select
Selection.AutoFilter Field:=1, Criteria1:6 + i
End If
Next j
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Offset(0, i - 1).Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, _
SkipBlanks:úlse, Transpose:=True
Next i
End Sub

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

Bonsoir Daniel mais je voudrais que cela continue plusieurs fois et
que
cela
me copie comme je le fais dans mon semblant de macro Merci d'avance;
Je
colle
cela a quel endroit de ma macro tu vois je n' y connais rien


Bonsoir.
Si j'ai bien compris, essaie :

For i = 1 To 5
If i <> 4 Then
Sheets("Feuil" & i).Select
Selection.AutoFilter Field:=1, Criteria1:="117"
End If
Next i

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

Bonsoir a toutes et a tous .Qui pourrait m'aider a construire une
macro
de
facons que je n'ai pas a recopier 8 fois la meme chose SVPmerci
de
bien
m'aider.Amitiées.Alain
Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="117"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L1").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
"ce qui est dessous est augmene de 1 pour criteria,rangeC1et
rangeL1

Sheets("Feuil1").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil2").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil3").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil5").Select
Selection.AutoFilter Field:=1, Criteria1:="118"
Sheets("Feuil4").Select
Application.Run "'RapidoComptage tirage2.xls'!Macro1"
Range("BL3:BL10").Select
Selection.Copy
Sheets("Feuil7").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
Sheets("Feuil4").Select
Range("CC3:CC4").Select
Selection.Copy
Sheets("Feuil7").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone,
SkipBlanks _
:úlse, Transpose:=True
























1 2