Macro 3 sur feuilles

Question

Bonjour a tous, J’ai cette macro qui copie des cellules de F1 à F2. (Ci-dessous) Il faudrait que certaines cellules une fois copiées en F2 (en rouge) se copie ensuite en F3 (en bleu). J’ai essayé de faire F2.Range ( : )= F3.Range( : ) mais ça ne marche pas. Pourriez-vous m’aider? Comment faire? Merci Sub Macro1() 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("B9").PasteSpecial Paste:=xlPasteAll, 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("C9").PasteSpecial Paste:=xlPasteAll, 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 (N13) ActiveSheet.Paste Link:=True .Range("Q16").Copy Range("C26").Select (K13) ActiveSheet.Paste Link:=True Range("B19").Value = .Range("C16").Value (B13) Range("B20:C20").Value = .Range("E16:F16").Value (G13:H13) Range("B21:C21").Value = .Range("H16:I16").Value (D13:E13) Range("B24").Value = .Range("K16").Value Range("B25").Value = .Range("H16").Value (M13) Range("B26").Value = .Range("P16").Value (J13) Range("B30").Value = .Range("I23").Value (P13) Range("B31:C31").Value = .Range("K23:L23").Value Range("B32:C32").Value = .Range("N23:O23").Value Range("B38:B40").Value .Range("F28:F30").Value Somme(B38:B40)=(S13) Range("B42:B44").Value = .Range("F31:F33").Value Range("D9:D12,D20:D21").FormulaR1C1 = "=RC[-2]*RC[-1]" (D20)=(I13), (D21)=(F13) Range("D19,D24,D30").FormulaR1C1 = "=R[1]C+R[2]C" (D19)=(C13), (D30)=(R13) 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

enilec89 · Answer

Re-bonjour,
G essayé autre chose. Une macro supplementaire.
Mais ca ne marche pas non plus.
Quelle est mon erreur?
Sub Macro()<?xml:namespace prefix o ns "urn:schemas-microsoft-com:office:office" /??>






 






Dim Lig_S As Long 





Dim Lig_D As Long





Dim F_S As Worksheet





Dim F_D As Worksheet





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("B38").Value + .Range("B39").Value + .Range("B40").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     






 







            








            Lig_D = Lig_D + 1






        End If






    End With





Next Lig_S






 






End sub

Macro 3 sur feuilles

1 réponse

Votre réponse

Discussions similaires