Sujet Précédent Sujet Suivant

[Déplacé .Net --> VBA] répéter une macro avec décalage de colonnes

enilec89 Messages postés 12 Date d'inscription vendredi 26 septembre 2008 Statut Membre Dernière intervention 1 décembre 2009 - 27 nov. 2009 à 19:16
enilec89 Messages postés 12 Date d'inscription vendredi 26 septembre 2008 Statut Membre Dernière intervention 1 décembre 2009 - 1 déc. 2009 à 18:55
Bonsoir,

J'avais déjà fait appelle à vous il y a un an. Et vous m'aviez bien aidé, donc je reviens vers vous pour la même macro.
J'ai une macro qui se répète 30 fois, mais il faudrai maintenant qu'elle se répète 90 fois. Mon code fait déjà 102 pages en fichier word !!!

En gros en fonction de la valeur de C4, il faut copier/coller dans une cellule différente mais sur la même ligne : B8 si la valeur de C4 est 1, F8 si la valeur de C4 est 2, etc. On décale de 4 colonnes à chaque fois.

Désolée si c pas très claire, mais je débute donc je ne sait pas trop comment expliquer.....
Merci pour votre aide.

Voici une partie de mon code:

Sub S1()

Dim Lig_S As Long
Dim Lig_D As Long
Dim F_S As Worksheet
Dim F_D As Worksheet
Set F_S = Sheets("F1")
Set F_D = Sheets("F2")
Lig_D = F_D.Range("A65536").End(xlUp).Row + 1

For Lig_S = 44 To 3 Step -1
With F_S

If F_S.Range("C4").Value = 1 Then
F_D.Select
Application.CutCopyMode = False

.Range("C40,E40,G40,I40").Copy
Range("A1000").Select
ActiveSheet.Paste Link:=True
Selection.Copy
Range("B8").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range("A1000").EntireRow.Delete

.Range(" D40,F40,H40,J40").Copy
Range("A1000").Select
ActiveSheet.Paste Link:=True
Selection.Copy
Range("C8").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range("A1000").EntireRow.Delete

.Range("M40").Copy
Range("C14").Select
ActiveSheet.Paste Link:=True

.Range("C20:D24").Copy
Range("B47:C51").Select
ActiveSheet.Paste Link:=True

.Range("U21:V22").Copy
Range("B54:C55").Select
ActiveSheet.Paste Link:=True

.Range("E28:E30").Copy
Range("C38:C40").Select
ActiveSheet.Paste Link:=True

.Range("E31:E33").Copy
Range("C42:C44").Select
ActiveSheet.Paste Link:=True

.Range("N16").Copy
Range("C25").Select
ActiveSheet.Paste Link:=True

.Range("Q16").Copy
Range("C26").Select
ActiveSheet.Paste Link:=True

Range("B19").Value = .Range("C16").Value
Range("B20:C20").Value = .Range("E16:F16").Value
Range("B21:C21").Value = .Range("H16:I16").Value
Range("B24").Value = .Range("K16").Value
Range("B25").Value = .Range("M16").Value
Range("B26").Value = .Range("P16").Value
Range("B30").Value = .Range("I23").Value
Range("B31:C31").Value = .Range("K23:L23").Value
Range("B32:C32").Value = .Range("N23:O23").Value
Range("B38:B40").Value = .Range("F28:F30").Value
Range("B42:B44").Value = .Range("F31:F33").Value

Range("D8:D11,D20:D21").FormulaR1C1 = "=RC[-2]*RC[-1]"
Range("D19,D24,D30").FormulaR1C1 = "=R[1]C+R[2]C"
Range("D25:D26,D31:D32,D38:D40,D42:D44,D47:D51,D54:D55").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("B34").FormulaR1C1 = "=R[-15]C+R[-10]C+R[-4]C"

Range("B14") = .Range("L40").Value + .Range("N40").Value

Range("DQ12").Value = .Range("O40").Value
Range("DR12") = .Range("O40").Value * .Range("Q40").Value
Range("DQ13").Value = .Range("S40").Value
Range("DR13") = .Range("S40").Value * .Range("U40").Value

Range("D14").FormulaR1C1 = "='F1'!R[26]C[8]*'F1'!R[26]C[9]"

Lig_D = Lig_D + 1
End If
End With
Next Lig_S

For Lig_S = 44 To 3 Step -1
With F_S

If F_S.Range("C4").Value = 2 Then
F_D.Select
Application.CutCopyMode = False

.Range("C40,E40,G40,I40").Copy
Range("A1000").Select
ActiveSheet.Paste Link:=True
Selection.Copy
Range("F8").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range("A1000").EntireRow.Delete

.Range(" D40,F40,H40,J40").Copy
Range("A1000").Select
ActiveSheet.Paste Link:=True
Selection.Copy
Range("G8").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range("A1000").EntireRow.Delete

.Range("M40").Copy
Range("G14").Select
ActiveSheet.Paste Link:=True

.Range("C20:D24").Copy
Range("F47:G51").Select
ActiveSheet.Paste Link:=True

.Range("U21:V22").Copy
Range("F54:G55").Select
ActiveSheet.Paste Link:=True

.Range("E28:E30").Copy
Range("G38:G40").Select
ActiveSheet.Paste Link:=True

.Range("E31:E33").Copy
Range("G42:G44").Select
ActiveSheet.Paste Link:=True

.Range("N16").Copy
Range("G25").Select
ActiveSheet.Paste Link:=True

.Range("Q16").Copy
Range("G26").Select
ActiveSheet.Paste Link:=True

Range("F19").Value = .Range("C16").Value
Range("F20:G20").Value = .Range("E16:F16").Value
Range("F21:G21").Value = .Range("H16:I16").Value
Range("F24").Value = .Range("K16").Value
Range("F25").Value = .Range("M16").Value
Range("F26").Value = .Range("P16").Value
Range("F30").Value = .Range("I23").Value
Range("F31:G31").Value = .Range("K23:L23").Value
Range("F32:G32").Value = .Range("N23:O23").Value
Range("F38:F40").Value = .Range("F28:F30").Value
Range("F42:F44").Value = .Range("F31:F33").Value

Range("H8:H11,H20:H21").FormulaR1C1 = "=RC[-2]*RC[-1]"
Range("H19,H24,H30").FormulaR1C1 = "=R[1]C+R[2]C"
Range("H25:H26,H31:H32,H38:H40,H42:H44,H47:H51,H54:H55").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("F34").FormulaR1C1 = "=R[-15]C+R[-10]C+R[-4]C"

Range("F14") = .Range("L40").Value

Range("DQ12").Value = .Range("O40").Value
Range("DR12") = .Range("O40").Value * .Range("Q40").Value
Range("DQ13").Value = .Range("S40").Value
Range("DR13") = .Range("S40").Value * .Range("U40").Value

Range("H14").FormulaR1C1 = "='F1'!R[26]C[4]*'F1'!R[26]C[5]"

Lig_D = Lig_D + 1
End If
End With
Next Lig_S

Sub S3()

Dim Lig_S As Long
Dim Lig_D As Long
Dim F1 As Worksheet
Dim F_S As Worksheet
Dim F_D As Worksheet
Set F1 = Sheets("F1")
Set F_S = Sheets("F2")
Set F_D = Sheets("F3")
Lig_D = F_D.Range("A65536").End(xlUp).Row + 1

For Lig_S = 44 To 3 Step -1
With F_S

If F1.Range("C4").Value = 1 Then
F_D.Select
Application.CutCopyMode = False

Range("B13").Value = .Range("B19").Value
Range("C13").Value = .Range("D19").Value
Range("G13:I13").Value = .Range("B20:D20").Value
Range("D13:F13").Value = .Range("B21:D21").Value
Range("J13:L13").Value = .Range("B26:D26").Value
Range("M13:O13").Value = .Range("B25:D25").Value
Range("P13").Value = .Range("B30").Value
Range("R13").Value = .Range("D30").Value
Range("S13") = .Range("B42").Value + .Range("B43").Value + .Range("B44").Value
Range("T13") = .Range("D42").Value + .Range("D43").Value + .Range("D44").Value
Range("B31") = .Range("B47").Value + .Range("B48").Value
Range("C31") = .Range("D47").Value + .Range("D48").Value
Range("D31") = .Range("B49").Value + .Range("B50").Value
Range("F31") = .Range("D49").Value + .Range("D50").Value
Range("G31:I31").Value = .Range("B51:D51").Value
Range("J31") = .Range("B54").Value + .Range("B55").Value
Range("L31") = .Range("D54").Value + .Range("D55").Value
Range("M31").Value = .Range("B38").Value
Range("O31").Value = .Range("D38").Value
Range("P31") = .Range("B39").Value + .Range("B40").Value
Range("Q31") = .Range("D39").Value + .Range("D40").Value
Range("R31") = .Range("D38").Value + .Range("D39").Value + .Range("D40").Value

Range("I41").Value = .Range("DQ12").Value - .Range("DQ19").Value + .Range("B19").Value
Range("K41").Value = .Range("DQ13").Value - .Range("DQ24").Value + .Range("B24").Value
Range("O41").Value = .Range("DQ14").Value - .Range("DQ30").Value + .Range("B30").Value

Range("I42") = 0
Range("K42") = 0
Range("O42") = .Range("B14").Value

Range("I43").Value = .Range("DQ19").Value
Range("K43").Value = .Range("DQ24").Value
Range("O43").Value = .Range("DQ30").Value

Range("M44").Value = .Range("DQ12").Value - Range("I43").Value - Range("K43").Value

Range("B15").Value = .Range("DQ19").Value
Range("C15").Value = .Range("DR19").Value
Range("D15").Value = .Range("DQ21").Value
Range("F15").Value = .Range("DR21").Value
Range("G15").Value = .Range("DQ20").Value
Range("I15").Value = .Range("DR20").Value
Range("J15").Value = .Range("DQ26").Value
Range("L15").Value = .Range("DR26").Value
Range("M15").Value = .Range("DQ25").Value
Range("O15").Value = .Range("DR25").Value
Range("P15").Value = .Range("DQ30").Value
Range("R15").Value = .Range("DR30").Value
Range("S15") = .Range("DQ42").Value + .Range("DQ43").Value + .Range("DQ44").Value
Range("T15") = .Range("DR42").Value + .Range("DR43").Value + .Range("DR44").Value
Range("B33") = .Range("DQ47").Value + .Range("DQ48").Value
Range("C33") = .Range("DR47").Value + .Range("DR48").Value
Range("D33") = .Range("DQ49").Value + .Range("DQ50").Value
Range("F33") = .Range("DR49").Value + .Range("DR50").Value
Range("G33").Value = .Range("DQ51").Value
Range("I33").Value = .Range("DR51").Value
Range("J33") = .Range("DQ54").Value + .Range("DQ55").Value
Range("L33") = .Range("DR54").Value + .Range("DR55").Value
Range("M33").Value = .Range("DQ38").Value
Range("O33").Value = .Range("DR38").Value
Range("P33") = .Range("DQ39").Value + .Range("DQ40").Value
Range("Q33") = .Range("DR39").Value + .Range("DR40").Value
Range("R33") = .Range("DR38").Value + .Range("DR39").Value + .Range("DR40").Value

Lig_D = Lig_D + 1
End If
End With
Next Lig_S

For Lig_S = 44 To 3 Step -1
With F_S

If F1.Range("C4").Value = 2 Then
F_D.Select
Application.CutCopyMode = False

Range("B13").Value = .Range("F19").Value
Range("C13").Value = .Range("H19").Value
Range("G13:I13").Value = .Range("F20:H20").Value
Range("D13:F13").Value = .Range("F21:H21").Value
Range("J13:L13").Value = .Range("F26:H26").Value
Range("M13:O13").Value = .Range("F25:H25").Value
Range("P13").Value = .Range("F30").Value

Range("R13").Value = .Range("H30").Value
Range("S13") = .Range("F42").Value + .Range("F43").Value + .Range("F44").Value
Range("T13") = .Range("H42").Value + .Range("H43").Value + .Range("H44").Value
Range("B31") = .Range("F47").Value + .Range("F48").Value
Range("C31") = .Range("H47").Value + .Range("H48").Value
Range("D31") = .Range("F49").Value + .Range("F50").Value
Range("F31") = .Range("H49").Value + .Range("H50").Value
Range("G31:I31").Value = .Range("F51:H51").Value
Range("J31") = .Range("F54").Value + .Range("F55").Value
Range("L31") = .Range("H54").Value + .Range("H55").Value
Range("M31").Value = .Range("F38").Value
Range("O31").Value = .Range("H38").Value
Range("P31") = .Range("F39").Value + .Range("F40").Value
Range("Q31") = .Range("H39").Value + .Range("H40").Value
Range("R31") = .Range("H38").Value + .Range("H39").Value + .Range("H40").Value

Range("I41").Value = .Range("DQ12").Value - .Range("DQ19").Value + .Range("F19").Value
Range("K41").Value = .Range("DQ13").Value - .Range("DQ24").Value + .Range("F24").Value
Range("O41").Value = .Range("DQ14").Value - .Range("DQ30").Value + .Range("F30").Value

Range("I42") = 0
Range("K42") = 0
Range("O42") = .Range("F14").Value

Range("I43").Value = .Range("DQ19").Value
Range("K43").Value = .Range("DQ24").Value
Range("O43").Value = .Range("DQ30").Value

Range("M44").Value = .Range("DQ12").Value - Range("I43").Value - Range("K43").Value

Range("B15").Value = .Range("DQ19").Value
Range("C15").Value = .Range("DR19").Value
Range("D15").Value = .Range("DQ21").Value
Range("F15").Value = .Range("DR21").Value
Range("G15").Value = .Range("DQ20").Value
Range("I15").Value = .Range("DR20").Value
Range("J15").Value = .Range("DQ26").Value
Range("L15").Value = .Range("DR26").Value
Range("M15").Value = .Range("DQ25").Value
Range("O15").Value = .Range("DR25").Value
Range("P15").Value = .Range("DQ30").Value
Range("R15").Value = .Range("DR30").Value
Range("S15") = .Range("DQ42").Value + .Range("DQ43").Value + .Range("DQ44").Value
Range("T15") = .Range("DR42").Value + .Range("DR43").Value + .Range("DR44").Value
Range("B33") = .Range("DQ47").Value + .Range("DQ48").Value
Range("C33") = .Range("DR47").Value + .Range("DR48").Value
Range("D33") = .Range("DQ49").Value + .Range("DQ50").Value
Range("F33") = .Range("DR49").Value + .Range("DR50").Value
Range("G33").Value = .Range("DQ51").Value
Range("I33").Value = .Range("DR51").Value
Range("J33") = .Range("DQ54").Value + .Range("DQ55").Value
Range("L33") = .Range("DR54").Value + .Range("DR55").Value
Range("M33").Value = .Range("DQ38").Value
Range("O33").Value = .Range("DR38").Value
Range("P33") = .Range("DQ39").Value + .Range("DQ40").Value
Range("Q33") = .Range("DR39").Value + .Range("DR40").Value
Range("R33") = .Range("DR38").Value + .Range("DR39").Value + .Range("DR40").Value

Lig_D = Lig_D + 1
End If
End With
Next Lig_S

Sub S6()

Dim Lig_S As Long
Dim Lig_D As Long
Dim F_S As Worksheet
Dim F_D As Worksheet
Set F_S = Sheets("F1")
Set F_D = Sheets("F3")
Lig_D = F_D.Range("A65536").End(xlUp).Row + 1

For Lig_S = 44 To 3 Step -1
With F_S
F_D.Select
Application.CutCopyMode = False

Range("B4") = .Range("C4")
Range("F4") = .Range("G4")

Range("N4").Value = .Range("D16").Value
Range("O4").Value = .Range("G16").Value
Range("P4").Value = .Range("L16").Value
Range("Q4").Value = .Range("O16").Value
Range("R4").Value = .Range("J23").Value
Range("S4").Value = .Range("M23").Value

End With
Next Lig_S
End Sub



Sub S()
'
'
Application.Run "S1"
Application.Run "S2"
Application.Run "S3"
Application.Run "S4"
Application.Run "S5"
Application.Run "S6"
End Sub

5 réponses

Réponse 1 / 5
cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 79
28 nov. 2009 à 09:23
Salut
Désolé, mais personne n'aura le courage de lire tes lignes trop nombreuses.
Une bonne explication vaut tous les programmes du monde !

Ton problème n'est qu'un problème de mathématique :
Comment désigner le numéro d'une colonne en fonction du contenu d'une cellule, sachant que le décalage est une constante, 4.

Tu dis :
B8 si la valeur est 1 (B = colonne 2)
F8 si la valeur est 2 (F = colonne 6)
Ceci n'est qu'une équation du premier degré. Tu n'as pas révisé tes cours de 6ème ?
y = a * x + b
avec
2 = a * 1 + b
6 = a * 2 + b

6-2 = a * (2-1)
donc a = 6-2 / (2-1)
donc a = 4

Si a = 4
6 = 4 * 2 + b
donc b = 6 - 4*2
donc b = -2

Au final :
NoColonne = 4 * CelluleC4 - 2
Exemple si CelluleC4 2 --> NoColonne 4*2 - 2 = 6
Exemple si CelluleC4 3 --> NoColonne 4*3 - 2 = 10
etc ...

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
0
Réponse 2 / 5
us_30 Messages postés 2065 Date d'inscription lundi 11 avril 2005 Statut Membre Dernière intervention 14 mars 2016 10
28 nov. 2009 à 14:16
Bonjour,

Euh... tu te tapes un délire!
Tu veux faire presque rien, et tu as un codage incroyablement long... On programme jamais avec autant de ligne pour de simples copier/coller... Il faut absolument penser les choses autrement (au niveau du codage ou de l'organisation du tableau) !

Dans l'immédiat, je n'ai pas le temps de regarder ton code... Mais si tu pouvais décrire un peu plus les actions que tu fais, cela pourrait aider à trouver une solution de codage beaucoup plus élégante...

Amicalement,
Us.
0
Réponse 3 / 5
enilec89 Messages postés 12 Date d'inscription vendredi 26 septembre 2008 Statut Membre Dernière intervention 1 décembre 2009
28 nov. 2009 à 19:09
Oui c'est vrais qu'il y a surement plus simple et plus élégant, mais j'ai honte de le dire, j'ai déjà eu du mal à pondre ce code très confu....
Je vais essayer de trouver les mots....

En fait, j'ai un document excel avec 3 feuilles.
- La feuille 1 est un tableau a remplir tous les jours
- la feuille 2 est un tableau dans lequel doit se reporter certaines cellules de la feuille 1 dans les colonnes Jour 1 à Jour 90 en fonction du jour inscrit sur la feuille 1. Si (J) 1, on remplira les colonnes JOUR 1 de la feuille B, si (J) 2, les colonnes JOUR 2, etc?
- la feuille 3 se met à jour par la même macro, mais reprend des cellules de la feuille 2.

Nous aurons donc chaque jour :
- une nouvelle feuille 1 qui écrase la précédente
- une feuille 2 qui se complète dans les colonnes JOUR 1 à JOUR 90 en fonction du jour de la feuille 1 (C4) et qui cumule tous les jours.
- Une nouvelle fiche 3 dont les résultats viendront de la feuille 2 et qui écrase la précédente .

Voilà, j'ai essayé d'être le plus clair possible mais soyez indulgents, je ne fait que débutanter.

Jack, j'adore ton résonement mathématique auquel je n'avait absolument pas pensé.
Cela dit je ne suis pas sure de comprendre comment l'utiliser...

Un grand merci
Céline
0
Réponse 4 / 5
cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 79
30 nov. 2009 à 21:05
Pour le calcul, je t'ai fourni la méthode pour trouver le chiffre correspond à ta colonne en fonction du n° de ligne.
Tu n'as plus qu'à te familiariser avec la désignation d'une cellule par son numéro de ligne et de colonne : voir Cells(x, y) et éventuellement Cells(x, y).Offset(z, t) (si tu dois te désigner une cellule voisine sans déplacer ta sélection) qui sont les fonctions les plus utilisées en VBA de Excel !

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 5
enilec89 Messages postés 12 Date d'inscription vendredi 26 septembre 2008 Statut Membre Dernière intervention 1 décembre 2009
1 déc. 2009 à 18:55
Jack, merci pour tes explications.

J'ai essayé de m?intéressé d'un peu plus près aux Cells(x, y) mais je suis un peu perdu et j'ai peur qu'en remplaçant les ranges par des cells, mont code deviennent de plus en plus long.
Serait-il possible d'appliquer ta formule à la macro entière ?
Les Ranges avec un point devant ne changent jamais.
Seul les Ranges sans point devant varient en fonction de la valeur de C4.
Ce sont eux que je devrais décaler de 4 colonnes à chaque fois.
Peut-on demander d'exécuter la même macro en décalant toutes le range sans point devant de 4 colonnes à chaque fois ?

Encore merci
Céline
0

Discussions similaires

créer un tirage de tarot divinatoire
copersil -
bultez -

12 réponses
Dernière cellule non vide d'une colonne
cs_falafala -
Luigi13013 -

5 réponses
Tchat en C via internet
born2be -
katsankat -

5 réponses
Comment fonctionne la fonction FormulaR1C1
cs_razmokets -
wape -

2 réponses
fonction modulo en VBA
krisprolss -
Benouille -

2 réponses
Rejoignez-nous