Sujet Précédent Sujet Suivant

Raccourcir une macro

enilec89 Messages postés 12 Date d'inscription vendredi 26 septembre 2008 Statut Membre Dernière intervention 1 décembre 2009 - 7 oct. 2008 à 16:04
enilec89 Messages postés 12 Date d'inscription vendredi 26 septembre 2008 Statut Membre Dernière intervention 1 décembre 2009 - 9 oct. 2008 à 11:58
Bonjour,
Je débute et je voudrais savoir s'il est possible et comment raccourcir ma macro qui se répète 30 fois. Elle est trop longue et donc ne peut s'executer.
Merci par avance pour votre aide.
Sub Macro1()<?xml:namespace prefix o ns "urn:schemas-microsoft-com:office:office" /??>

 

Dim Lig_S As Long 'Ligne source

Dim Lig_D As Long 'ligne destination

Dim F_S As Worksheet 'Feuille source

Dim F_D As Worksheet 'Feuille Destination

 

Set F_S = Sheets("F1") 'F1 est le nom de l'onglet source

Set F_D = Sheets("F2") 'F2 est le nom de l'onglet destination

Lig_D = F_D.Range("A65536").End(xlUp).Row + 1 'Ligne destination

 

For Lig_S = 44 To 3 Step -1

If F_S.Range("C4") = 1 Then

Sheets("F1").Select

Range("C40: D40").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("F2").Select

Range("B9: C9").Select

ActiveSheet.Paste Link:=True

Sheets("F1").Select

Range("E40: F40").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("F2").Select

Range("B10: C10").Select

ActiveSheet.Paste Link:=True

Sheets("F1").Select

Range("G40: H40").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("F2").Select

Range("B11: C11").Select

ActiveSheet.Paste Link:=True

Sheets("F1").Select

Range("I40: J40").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("F2").Select

Range("B12: C12").Select

ActiveSheet.Paste Link:=True

Sheets("F1").Select

Range("M40: M40").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("F2").Select

Range("C14").Select

ActiveSheet.Paste Link:=True

Sheets("F1").Select

Range("C20:D24").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("F2").Select

Range("B47:C51").Select

ActiveSheet.Paste Link:=True

Sheets("F1").Select

Range("U21:V22").Select

Selection.Copy

Sheets("F2").Select

Range("B54:C55").Select

ActiveSheet.Paste Link:=True

Sheets("F1").Select

Range("E28:E30").Select

Selection.Copy

Sheets("F2").Select

Range("C38:C40").Select

ActiveSheet.Paste Link:=True

Sheets("F1").Select

Range("E31:E33").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("F2").Select

Range("C42:C44").Select

ActiveSheet.Paste Link:=True

Sheets("F1").Select

Range("N16").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("F2").Select

Range("C25").Select

ActiveSheet.Paste Link:=True

Sheets("F1").Select

Range("Q16").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("F2").Select

Range("C26").Select

ActiveSheet.Paste Link:=True

Sheets("F1").Range("C16").Copy

Sheets("F2").Range("B19").PasteSpecial Paste:=xlPasteValues

Sheets("F1").Range("E16").Copy

Sheets("F2").Range("B20").PasteSpecial Paste:=xlPasteValues

Sheets("F1").Range("H16").Copy

Sheets("F2").Range("B21").PasteSpecial Paste:=xlPasteValues

Sheets("F1").Range("F16").Copy

Sheets("F2").Range("C20").PasteSpecial Paste:=xlPasteValues

Sheets("F1").Range("I16").Copy

Sheets("F2").Range("C21").PasteSpecial Paste:=xlPasteValues

Sheets("F1").Range("K16").Copy

Sheets("F2").Range("B24").PasteSpecial Paste:=xlPasteValues

Sheets("F1").Range("H16").Copy

Sheets("F2").Range("B25").PasteSpecial Paste:=xlPasteValues

Sheets("F1").Range("P16").Copy

Sheets("F2").Range("B26").PasteSpecial Paste:=xlPasteValues

Sheets("F1").Range("I23").Copy

Sheets("F2").Range("B30").PasteSpecial Paste:=xlPasteValues

Sheets("F1").Range("K23").Copy

Sheets("F2").Range("B31").PasteSpecial Paste:=xlPasteValues

Sheets("F1").Range("N23").Copy

Sheets("F2").Range("B32").PasteSpecial Paste:=xlPasteValues

Sheets("F1").Range("L23").Copy

Sheets("F2").Range("C31").PasteSpecial Paste:=xlPasteValues

Sheets("F1").Range("O23").Copy

Sheets("F2").Range("C32").PasteSpecial Paste:=xlPasteValues

Sheets("F1").Range("F28:F30").Copy

Sheets("F2").Range("B38:B40").PasteSpecial Paste:=xlValues

Sheets("F1").Range("F31:F33").Copy

Sheets("F2").Range("B42:B44").PasteSpecial Paste:=xlValues

Range("D9").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D10").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D11").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D12").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D20").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D21").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D19").FormulaR1C1 = "=R[1]C+R[2]C"

Range("D25").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D26").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D24").FormulaR1C1 = "=R[1]C+R[2]C"

Range("D31").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D32").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D30").FormulaR1C1 = "=R[1]C+R[2]C"

Range("D38").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D39").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D40").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D42").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D43").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D44").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D47").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D48").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D49").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D50").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D51").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D54").FormulaR1C1 = "=RC[-2]*RC[-1]"

Range("D55").FormulaR1C1 = "=RC[-2]*RC[-1]"

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

 

Sheets("F2").Range("B14") = Sheets("F1").Range("L40").Value + Sheets("F1").Range("N40").Value

 

Range("D14").Select

    ActiveCell.FormulaR1C1 = _

        "='F1'!R[26]C[8]*'F1'!R[26]C[9]+'F1'!R[26]C[10]*'F1'!R[26]C[11]"

   

Lig_D = Lig_D + 1

End If

Next Lig_S

 

 

End Sub

 

12 réponses

Réponse 1 / 12
gillardg Messages postés 3275 Date d'inscription jeudi 3 avril 2008 Statut Membre Dernière intervention 14 septembre 2014 2
7 oct. 2008 à 16:15
découpe tout ça en plusieurs sub que tu appeleras l'un après l'autre

Bonjour chez vous !
0
Réponse 2 / 12
enilec89 Messages postés 12 Date d'inscription vendredi 26 septembre 2008 Statut Membre Dernière intervention 1 décembre 2009
7 oct. 2008 à 17:07
Merci pour l'idée mais ca semble assez compliquer.....
Je peut decouper la macro mais comment appeler une macro dans une autre?
0
Réponse 3 / 12
gillardg Messages postés 3275 Date d'inscription jeudi 3 avril 2008 Statut Membre Dernière intervention 14 septembre 2014 2
7 oct. 2008 à 17:19
sub un()


call deux


end sub


sub deux


' ton truc ici
end sub










Bonjour chez vous !
0
Réponse 4 / 12
bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 15
7 oct. 2008 à 18:19
Salut,




le fait que ta macro ne puisse s'executer n'a rien avoir avec sa longueur !




Voici lle code en version simplifié :




Les Range avec un point devant sont liés a la feuille F1 via le with




les Range sans point devant sont liés a la feuille selectionné en debut de code c'est a dire la feuille F2




Sub Macro1()



Dim Lig_S As Long 'Ligne source

Dim Lig_D As Long 'ligne destination

Dim F_S As Worksheet 'Feuille source



Dim F_D As Worksheet 'Feuille Destination





Set F_S = Sheets("F1") 'F1 est le nom de l'onglet source
Set F_D = Sheets("F2") 'F2 est le nom de l'onglet destination
Lig_D = F_D.Range("A65536").End(xlUp).Row + 1 'Ligne destination





For Lig_S = 44 To 3 Step -1
    With F_S 'Avec la feuille F1
    
        If F_S.Range("C4").Value = 1 Then
            F_D.Select 'selection de la feuille F2
            Application.CutCopyMode = False 'une fois suffit !!!
            
            .Range("C40,E40,G40,I40").Copy
            Range("A1000").Select 'Zone temporaire
            ActiveSheet.Paste Link:=True
            Selection.Copy
            Range("B9").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
            Range("A1000").EntireRow.Delete 'on efface la zone temporaire
            
            .Range(" D40,F40,H40,J40").Copy
            Range("A1000").Select 'Zone temporaire
            ActiveSheet.Paste Link:=True
            Selection.Copy
            Range("C9").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
            Range("A1000").EntireRow.Delete 'on efface la zone temporaire
            
            .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("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("D9:D12,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("D14").FormulaR1C1 = "='F1'!R[26]C[8]*'F1'!R[26]C[9]+'F1'!R[26]C[10]*'F1'!R[26]C[11]"
            
            Lig_D = Lig_D + 1
        End If
    End With
Next Lig_S

End Sub

A+
0

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

Posez votre question
Réponse 5 / 12
enilec89 Messages postés 12 Date d'inscription vendredi 26 septembre 2008 Statut Membre Dernière intervention 1 décembre 2009
7 oct. 2008 à 19:36
SUPER !!!
Merci Bigfish, ton code marche super bien et il est bien plus court que le mien....
C exactement ce qu'il me fallait!!
Merci aussi a Gillardg, je ne savait pas que l'on pouvait appeler une macro dans une autre. Très utile!
G beaucoup appris grace a vous 2.
0
Réponse 6 / 12
enilec89 Messages postés 12 Date d'inscription vendredi 26 septembre 2008 Statut Membre Dernière intervention 1 décembre 2009
8 oct. 2008 à 11:31
Oups, petit probleme....


La macro de Bigfish marche tres bien seule, mais je doit la repeter 30 fois en midifiant cette instuction:



        If F_S.Range("C4").Value = 1 Then

et la ca ne marche plus...

Qu'ai-je mal fait?





Sub Macro1()

<?xml:namespace prefix o ns "urn:schemas-microsoft-com:office:office" /??>







Dim Lig_S As Long 'Ligne source
Dim Lig_D As Long 'ligne destination
Dim F_S As Worksheet 'Feuille source


Dim F_D As Worksheet 'Feuille Destination








Set F_S = Sheets("F1") 'F1 est le nom de l'onglet source
Set F_D = Sheets("F2") 'F2 est le nom de l'onglet destination
Lig_D = F_D.Range("A65536").End(xlUp).Row + 1 'Ligne destination







For Lig_S = 44 To 3 Step -1
    With F_S 'Avec la feuille F1
    
        If F_S.Range("C4").Value = 1 Then
            F_D.Select 'selection de la feuille F2
            Application.CutCopyMode = False 'une fois suffit !!!
            
            .
Range("C40,E40,G40,I40").Copy
            Range("A1000").Select 'Zone temporaire
            ActiveSheet.Paste Link:=True
            Selection.Copy
            Range("B9").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
            Range("A1000").EntireRow.Delete 'on efface la zone temporaire
            
            .Range(" D40,F40,H40,J40").Copy
            Range("A1000").Select 'Zone temporaire
            ActiveSheet.Paste Link:=True
            Selection.Copy
            Range("C9").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
            Range("A1000").EntireRow.Delete 'on efface la zone temporaire
            
            .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("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("D9:D12,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("D14").FormulaR1C1 = "='F1'!R[26]C[8]*'F1'!R[26]C[9]+'F1'!R[26]C[10]*'F1'!R[26]C[11]"
            
            Lig_D = Lig_D + 1
        End If
    End With
Next Lig_S





For Lig_S = 44 To 3 Step -1
    With F_S 'Avec la feuille F1
    
        If F_S.Range("C4").Value = 2 Then
            F_D.Select 'selection de la feuille F2
            Application.CutCopyMode = False 'une fois suffit !!!
            
            .Range("C40,E40,G40,I40").Copy
            Range("A1000").Select 'Zone temporaire
            ActiveSheet.Paste Link:=True
            Selection.Copy
            Range("F9").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipFlanks:= _
            False, Transpose:=True
            Range("A1000").EntireRow.Delete 'on efface la zone temporaire
            
            .Range(" D40,F40,H40,J40").Copy
            Range("A1000").Select 'Zone temporaire
            ActiveSheet.Paste Link:=True
            Selection.Copy
            Range("G9").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipFlanks:= _
            False, Transpose:=True
            Range("A1000").EntireRow.Delete 'on efface la zone temporaire
            
            .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("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("H9:H12,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("N40").Value

            Range("H14").FormulaR1C1 = "='F1'!R[26]C[8]*'F1'!R[26]C[9]+'F1'!R[26]C[10]*'F1'!R[26]C[11]"
            
            Lig_D = Lig_D + 1
        End If
    End With
Next Lig_S
End sub




 
0
Réponse 7 / 12
bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 15
8 oct. 2008 à 15:44
Salut,

tu peux repreciser un peu et me donner la 2ieme partie du code en mettant en en evidence (couleur ou autre) les lignes de code differentes de la premiere partie
0
Réponse 8 / 12
enilec89 Messages postés 12 Date d'inscription vendredi 26 septembre 2008 Statut Membre Dernière intervention 1 décembre 2009
8 oct. 2008 à 17:54
Voila, la seule chose qui change c'est
If F_S.Range("C4").Value = 1 ou 2ou 3 ect (30fois) Then
G aussi un message d'erreur sur SkipFlanks a partir de la 2eme partie du code.
Désolée si c pas tres claire , mais je débute donc je ne sait pas trop comment expliquer.....

Sub Macro1()

<?xml:namespace prefix o ns "urn:schemas-microsoft-com:office:office" /??>







Dim Lig_S As Long 'Ligne source
Dim Lig_D As Long 'ligne destination
Dim F_S As Worksheet 'Feuille source


Dim F_D As Worksheet 'Feuille Destination








Set F_S = Sheets("F1") 'F1 est le nom de l'onglet source
Set F_D = Sheets("F2") 'F2 est le nom de l'onglet destination
Lig_D = F_D.Range("A65536").End(xlUp).Row + 1 'Ligne destination







For Lig_S = 44 To 3 Step -1
    With F_S 'Avec la feuille F1
    
        If F_S.Range("C4").Value = 1 Then
            F_D.Select 'selection de la feuille F2
            Application.CutCopyMode = False 'une fois suffit !!!
            
            .
Range("C40,E40,G40,I40").Copy
            Range("A1000").Select 'Zone temporaire
            ActiveSheet.Paste Link:=True
            Selection.Copy
            Range("B9").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
            Range("A1000").EntireRow.Delete 'on efface la zone temporaire
            
            .Range(" D40,F40,H40,J40").Copy
            Range("A1000").Select 'Zone temporaire
            ActiveSheet.Paste Link:=True
            Selection.Copy
            Range("C9").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
            Range("A1000").EntireRow.Delete 'on efface la zone temporaire
            
            .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("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("D9:D12,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("D14").FormulaR1C1 = "='F1'!R[26]C[8]*'F1'!R[26]C[9]+'F1'!R[26]C[10]*'F1'!R[26]C[11]"
            
            Lig_D = Lig_D + 1
        End If
    End With
Next Lig_S





For Lig_S = 44 To 3 Step -1
    With F_S 'Avec la feuille F1
    
        If F_S.Range("C4").Value = 2 Then
            F_D.Select 'selection de la feuille F2
            Application.CutCopyMode = False 'une fois suffit !!!
            
            .Range("C40,E40,G40,I40").Copy
            Range("A1000").Select 'Zone temporaire
            ActiveSheet.Paste Link:=True
            Selection.Copy
            Range("F9").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipFlanks:= _
            False, Transpose:=True
            Range("A1000").EntireRow.Delete 'on efface la zone temporaire
            
            .Range(" D40,F40,H40,J40").Copy
            Range("A1000").Select 'Zone temporaire
            ActiveSheet.Paste Link:=True
            Selection.Copy
            Range("G9").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipFlanks:= _
            False, Transpose:=True
            Range("A1000").EntireRow.Delete 'on efface la zone temporaire
            
            .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("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("H9:H12,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("N40").Value

            Range("H14").FormulaR1C1 = "='F1'!R[26]C[8]*'F1'!R[26]C[9]+'F1'!R[26]C[10]*'F1'!R[26]C[11]"
            
            Lig_D = Lig_D + 1
        End If
    End With
Next Lig_S






For Lig_S = 44 To 3 Step -1
    With F_S 'Avec la feuille F1
    
        If F_S.Range("C4").Value = 3 Then
            F_D.Select 'selection de la feuille F2
            Application.CutCopyMode = False 'une fois suffit !!!
            
            .Range("C40,E40,G40,I40").Copy
            Range("A1000").Select 'Zone temporaire
            ActiveSheet.Paste Link:=True
            Selection.Copy
            Range("J9").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipJlanks:= _
            False, Transpose:=True
            Range("A1000").EntireRow.Delete 'on efface la zone temporaire
            
            .Range(" D40,F40,H40,J40").Copy
            Range("A1000").Select 'Zone temporaire
            ActiveSheet.Paste Link:=True
            Selection.Copy
            Range("K9").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipJlanks:= _
            False, Transpose:=True
            Range("A1000").EntireRow.Delete 'on efface la zone temporaire
            
            .Range("M40").Copy
            Range("K14").Select
            ActiveSheet.Paste Link:=True
    
            .Range("C20:D24").Copy
            Range("J47:K51").Select
            ActiveSheet.Paste Link:=True
    
            .Range("U21:V22").Copy
            Range("J54:K55").Select
            ActiveSheet.Paste Link:=True
            
            .Range("E28:E30").Copy
            Range("K38:K40").Select
            ActiveSheet.Paste Link:=True

            .Range("E31:E33").Copy
            Range("K42:K44").Select
            ActiveSheet.Paste Link:=True

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

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

            Range("J19").Value = .Range("C16").Value
            Range("J20:K20").Value = .Range("E16:F16").Value
            Range("J21:K21").Value = .Range("H16:I16").Value
            Range("J24").Value = .Range("K16").Value
            Range("J25").Value = .Range("H16").Value
            Range("J26").Value = .Range("P16").Value
            Range("J30").Value = .Range("I23").Value
            Range("J31:K31").Value = .Range("K23:L23").Value
            Range("J32:K32").Value = .Range("N23:O23").Value
            Range("J38:J40").Value = .Range("F28:F30").Value
            Range("J42:J44").Value = .Range("F31:F33").Value
            
            Range("L9:L12,L20:L21").FormulaR1C1 = "=RC[-2]*RC[-1]"
            Range("L19,L24,L30").FormulaR1C1 = "=R[1]C+R[2]C"
            Range("L25:L26,L31:L32,L38:L40,L42:L44,L47:L51,L54:L55").FormulaR1C1 = "=RC[-2]*RC[-1]"

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

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

            Range("L14").FormulaR1C1 = "='F1'!R[26]C[8]*'F1'!R[26]C[9]+'F1'!R[26]C[10]*'F1'!R[26]C[11]"
            
            Lig_D = Lig_D + 1
        End If
    End With
Next Lig_S

End sub
0
Réponse 9 / 12
bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 15
8 oct. 2008 à 18:15
Ça je l'ai compris ! ce que je veux c'est que tu me dise quelle ligne sont differentes dans le reste du code car je veux bien t'aider mais je peux pas y passer ma journée
0
Réponse 10 / 12
enilec89 Messages postés 12 Date d'inscription vendredi 26 septembre 2008 Statut Membre Dernière intervention 1 décembre 2009
8 oct. 2008 à 18:18
En fait les lignes sont toutes les memes, il n'y a que les cellules qui changent.
0
Réponse 11 / 12
bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 15
8 oct. 2008 à 18:37
et ben c'est ce dont que j'ai besoin de c'est ligne ou les cellules changes !
0
Réponse 12 / 12
enilec89 Messages postés 12 Date d'inscription vendredi 26 septembre 2008 Statut Membre Dernière intervention 1 décembre 2009
9 oct. 2008 à 11:58
G trouvé mon erreur (stupide en plus).
Maintenant ca marche super bien!!!
Une derniere petite question et promis j'arrete de t'embeter:
Comment réaliser la transposition en conservant les liaisons aux
cellules?
Ce serai pour cette partie du code:
       
If F_S.Range("C4").Value = 1 Then
            F_D.Select 'selection de la feuille F2
            Application.CutCopyMode = False 'une fois suffit !!!
            
            .Range("C40,E40,G40,I40").Copy
            Range("A1000").Select 'Zone temporaire
            ActiveSheet.Paste Link:=True
            Selection.Copy
            Range("B9").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
            Range("A1000").EntireRow.Delete 'on efface la zone temporaire
            
            .Range(" D40,F40,H40,J40").Copy
            Range("A1000").Select 'Zone temporaire
            ActiveSheet.Paste Link:=True
            Selection.Copy
            Range("C9").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
            Range("A1000").EntireRow.Delete 'on efface la zone temporaire
0

Discussions similaires

Récupérer par une macro les dimension d'une pièce sur CATIA
fehmous -
fehmous -

4 réponses
Activer macros outlook
biggir -
ajarnaud -

4 réponses
comment activer les macro dans outlook
eryk17 -
alias666 -

1 réponse
Les macros sur Outlook ne fonctionnent plus et ne sont plus accessibles !
gary7bon -
gone -

5 réponses
Lancer une macro automatiquement 1 fois par semaine
alexpepe -
ucfoutu -

2 réponses
Rejoignez-nous