passiflore
XLDnaute Nouveau
Bonjour,
Je débute en VBA, et j’ai besoin de votre aide.
Je vais essayer de trouver les mots....
J'ai une macro qui se répète 30 fois, mais il faudrait maintenant qu'elle se répète 90 fois. Mon code fait déjà 102 pages en fichier Word !!!
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 (C4). 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.
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.
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 ?
Merci par avance pour votre aide.
Céline
Voici une partie de mon code:
Bonjour,
Je n'arrive pas a mettre mon fichier, il est trop lourd même compressé...
Je débute en VBA, et j’ai besoin de votre aide.
Je vais essayer de trouver les mots....
J'ai une macro qui se répète 30 fois, mais il faudrait maintenant qu'elle se répète 90 fois. Mon code fait déjà 102 pages en fichier Word !!!
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 (C4). 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.
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.
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 ?
Merci par avance pour votre aide.
Céline
Voici une partie de mon code:
Sub SAM1()
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("C14").Value = .Range("M40").Value
Range("B47:C51").Value = .Range("C2024").Value
Range("B54:C55").Value = .Range("T21:U22").Value
Range("C38:C40").Value = .Range("E28:E30").Value
Range("C42:C44").Value = .Range("E31:E33").Value
Range("C25").Value = .Range("N16").Value
Range("C26").Value = .Range("Q16").Value
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("H16").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("D811,D2021").FormulaR1C1 = "=RC[-2]*RC[-1]"
Range("D19,D24,D30").FormulaR1C1 = "=R[1]C+R[2]C"
Range("D2526,D3132,D3840,D4244,D4751,D5455").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("G14").Value = .Range("M40").Value
Range("F47:G51").Value = .Range("C2024").Value
Range("F54:G55").Value = .Range("T21:U22").Value
Range("G38:G40").Value = .Range("E28:E30").Value
Range("G42:G44").Value = .Range("E31:E33").Value
Range("G25").Value = .Range("N16").Value
Range("G26").Value = .Range("Q16").Value
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("H16").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
Bonjour,
Je n'arrive pas a mettre mon fichier, il est trop lourd même compressé...
Dernière édition: