OVH Cloud OVH Cloud

adapter un code pour listes

13 réponses
Avatar
YANN24
Bonjour,
j'ai eu un code par l'intermédiaire de Daniel la semaine dernière, et je
voudrais l'adapter. Le hic, c'est que je ne comprends pas les paramètres à
changer. Quelqu'un peut-il m'expliquer ?
1) je voudrais copier les valeurs et la mise en forme seulement.
2) je voudrais copier les cellules de la colonne C à la colonne Q, et
commencer ma sélection à la ligne 4. mais je ne sais pas quels paramètres
changer.

Je vous remercie.
YANN
----------- dans mon module
'1. Création de la liste :
Sub CreationListe()
Dim Ligne As Integer
Ligne = 1
On Error Resume Next
Sheets("Recap").Activate
If Err <> 0 Then
Sheets.Add
ActiveSheet.Name = "Recap"
Sheets("Analyse 05").Select
For i = 0 To 300 Step 20
Range("D4").Offset(i, 0).Copy Sheets("Recap").Range("A" & Ligne)
Ligne = Ligne + 1
Next i
End If
On Error GoTo 0
End Sub

'3. Module Routine :
Sub Routine(Var)
Sheets("Analyse 05").Select
Range("A" & Var & ":L" & Var + 18).Copy
Sheets("Recap").Select
Range("A20").Select
ActiveSheet.Paste
End Sub

---------------- Dans ma page "Recap"
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Var
If Intersect(Target, Range("A1:A15")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Var = Application.Match(Target.Value, Sheets("Analyse 05").Range("D:D"),
0)
Routine Var
Application.EnableEvents = True
End Sub

3 réponses

1 2
Avatar
YANN24
Re,
pour mon histoire de ligne, c'est OK.
avec ta nouvelle routine, ça me met mes 2 tableaux, mais je voudrais 2
tableaux de 2 personnes différentes.
En fait il faut soit 2 listes, soit que la copie se fasse une fois sur deux
en A20, et l'autre fois en Q20. est-ce possible? ça serait le mieux ainsi.
Je te remercie.
YANN


La routine suivante devrait le faire :

Sub Routine(Var)
Sheets("Analyse 05").Select
Range("C" & Var & ":Q" & Var + 18).Copy
Sheets("Recap").Select
Range("A20").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:úlse
Range("A20").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:úlse
Range("Q20").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:úlse
Range("Q20").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:úlse
'ActiveSheet.Paste
End Sub

A l'exception peut-être de ton problème de 1 ligne, à corriger.
Cordialement.
Daniel

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

Re,
bon, pour le décalage d'1 ligne, j'ai compris ça marche.
Mais pour mettre 2 listes sur une page, comment faire?
Merci d'avance.
YANN


Daniel,
j'ai encore ce petit souci de décalage d'une ligne la zone à copier, et
je
ne sais pas comment faire.
De plus, il faudrait que je puisse faire exactement la même liste sur les
colonnes Q et suivantes. Ext-ce possible? N'y aura-t-il pas de conflits?
je te remercie.
YANN


Bonjour,
j'ai eu un code par l'intermédiaire de Daniel la semaine dernière, et
je
voudrais l'adapter. Le hic, c'est que je ne comprends pas les
paramètres à
changer. Quelqu'un peut-il m'expliquer ?
1) je voudrais copier les valeurs et la mise en forme seulement.
2) je voudrais copier les cellules de la colonne C à la colonne Q, et
commencer ma sélection à la ligne 4. mais je ne sais pas quels
paramètres
changer.

Je vous remercie.
YANN
----------- dans mon module
'1. Création de la liste :
Sub CreationListe()
Dim Ligne As Integer
Ligne = 1
On Error Resume Next
Sheets("Recap").Activate
If Err <> 0 Then
Sheets.Add
ActiveSheet.Name = "Recap"
Sheets("Analyse 05").Select
For i = 0 To 300 Step 20
Range("D4").Offset(i, 0).Copy Sheets("Recap").Range("A" &
Ligne)
Ligne = Ligne + 1
Next i
End If
On Error GoTo 0
End Sub

'3. Module Routine :
Sub Routine(Var)
Sheets("Analyse 05").Select
Range("A" & Var & ":L" & Var + 18).Copy
Sheets("Recap").Select
Range("A20").Select
ActiveSheet.Paste
End Sub

---------------- Dans ma page "Recap"
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Var
If Intersect(Target, Range("A1:A15")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Var = Application.Match(Target.Value, Sheets("Analyse
05").Range("D:D"),
0)
Routine Var
Application.EnableEvents = True
End Sub













Avatar
Daniel
Tu peux essayer, en utilisant la cellule C1 de la feuille Recap :

Sub Routine(Var)
Sheets("Analyse 05").Select
Range("C" & Var & ":Q" & Var + 18).Copy
Sheets("Recap").Select
If [C1] = 0 Then
[C1] = 1
Range("A20").Select
Else
[C1] = 0
Range("Q20").Select
End If
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:úlse
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:úlse
'ActiveSheet.Paste
End Sub

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

Re,
pour mon histoire de ligne, c'est OK.
avec ta nouvelle routine, ça me met mes 2 tableaux, mais je voudrais 2
tableaux de 2 personnes différentes.
En fait il faut soit 2 listes, soit que la copie se fasse une fois sur
deux
en A20, et l'autre fois en Q20. est-ce possible? ça serait le mieux ainsi.
Je te remercie.
YANN


Avatar
YANN24
OK.
Je te remercie du tonner, ça fonctionne!!! C'est cool EXCEL avec des mecs
qui sont calés!!
merci encore et à bientôt.
YANN


Tu peux essayer, en utilisant la cellule C1 de la feuille Recap :

Sub Routine(Var)
Sheets("Analyse 05").Select
Range("C" & Var & ":Q" & Var + 18).Copy
Sheets("Recap").Select
If [C1] = 0 Then
[C1] = 1
Range("A20").Select
Else
[C1] = 0
Range("Q20").Select
End If
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:úlse
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:úlse
'ActiveSheet.Paste
End Sub

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

Re,
pour mon histoire de ligne, c'est OK.
avec ta nouvelle routine, ça me met mes 2 tableaux, mais je voudrais 2
tableaux de 2 personnes différentes.
En fait il faut soit 2 listes, soit que la copie se fasse une fois sur
deux
en A20, et l'autre fois en Q20. est-ce possible? ça serait le mieux ainsi.
Je te remercie.
YANN







1 2