Problème copier coller formule

Manu57

XLDnaute Nouveau
Bonjour,
Je suis nouveau sur le forum et j'ai besoin d'aide, je n'arrive plus à avancer.
Je vous explique mon programme. Le but est : à partir d'un fichier source (OF.xlsx dans mon exemple) d'extraire les valeurs dans un nouveau classeur(classeur1.xlsm) et d'ensuite les classer dans les différentes partie (feuilles). Mais le problème est que la feuille OF du classeur1 peut etre modifié par l'utilisateur et il faudrait qu'automatiquement les autres feuilles changent aussi. Mon problème est que lorsque je veux etendre une formule (celle pour recopier d'une feuille a l'autre) il faut entrer une plage mais je n'arrive pas a lui rentrer une plage variable. Comment pourrais-je faire ? je vous joint mes fichier.

Code:
With WB1.Worksheets(Feuil2.Name)
    .Range("L3") = "=IF(OF!L3="""","""",OF!L3)"
    .Range("L3").AutoFill Destination:=WB1.Worksheets(Feuil2.Name).Range("L3:P3"), 
c'es la ligne juste juste au dessus ou je galère.
Type:=xlFillDefault
    .Range("L3:P3").AutoFill Destination:=WB1.Worksheets(Feuil2.Name).Range("L3:P" & x), Type:=xlFillDefault
 End With
Voila la partie ou je bloque

et voila le code entier

Code:
Dim Fichier As String
Public WB1 As Workbook
Dim WB2 As String
Public x As Long
Dim feuilwb1 As String
Dim feuilwb2 As String
Dim FABF As String


Sub copie()
 
    Set WB1 = ThisWorkbook
    
    feuilwb1 = ActiveWorkbook.ActiveSheet.Name
    
    Fichier = Application.GetOpenFilename
    Workbooks.Open Filename:=Fichier
       
    WB2 = ActiveWorkbook.Name
    feuilwb2 = ActiveWorkbook.ActiveSheet.Name

    x = Workbooks(WB2).Worksheets(feuilwb2).Range("F" & Rows.Count).End(xlUp).Row
    Workbooks(WB2).Worksheets(feuilwb2).Range("A3:CQ" & x).Copy WB1.Worksheets(feuilwb1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    
    WB1.Worksheets(Feuil1.Name).Range("A3:K" & x).Copy WB1.Worksheets(Feuil9.Name).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    With WB1.Worksheets(Feuil1.Name).Range("A1:K" & x)
    .Copy WB1.Worksheets(Feuil2.Name).Range("A" & Rows.Count).End(xlUp).Offset(0, 0)
    .Copy WB1.Worksheets(Feuil3.Name).Range("A" & Rows.Count).End(xlUp).Offset(0, 0)
    .Copy WB1.Worksheets(Feuil4.Name).Range("A" & Rows.Count).End(xlUp).Offset(0, 0)
    .Copy WB1.Worksheets(Feuil6.Name).Range("A" & Rows.Count).End(xlUp).Offset(0, 0)
    .Copy WB1.Worksheets(Feuil7.Name).Range("A" & Rows.Count).End(xlUp).Offset(0, 0)
    End With
    
     
    WB1.Worksheets(Feuil1.Name).Range("CO:CJ,CD:CG,AF:AI,L:M").Delete Shift:=xlToLeft

    Copie_auto
    
    Workbooks(WB2).Close
     
    Range("A2:CA2").AutoFilter
    
End Sub

Sub OF()
With WB1.Worksheets(Feuil1.Name).Range("N3:O" & x)
.Copy WB1.Worksheets(Feuil9.Name).Range("L" & Rows.Count).End(xlUp).Offset(1, 0)
End With
End Sub



Private Sub CommandButton1_Click()

copie
OF

End Sub

Private Sub CommandButton2_Click()

ActiveSheet.Cells.Clear

End Sub

Private Sub CommandButton3_Click()

CommandButton2_Click
Feuil2.clear_CMS
Feuil3.clear_FAB
Feuil4.clear_TEST
Feuil6.clear_ST
Feuil7.clear_CTRLFIN
Feuil9.clear_OF

End Sub
Sub Copie_auto()
Dim FABF As String


    With WB1.Worksheets(Feuil2.Name)
    .Range("L3") = "=IF(OF!L3="""","""",OF!L3)"
    .Range("L3").AutoFill Destination:=WB1.Worksheets(Feuil2.Name).Range("L3:P3"), Type:=xlFillDefault
    .Range("L3:P3").AutoFill Destination:=WB1.Worksheets(Feuil2.Name).Range("L3:P" & x), Type:=xlFillDefault
    End With
    
    With WB1.Worksheets(Feuil3.Name)
    .Range("L3") = "=IF(OF!Q3="""","""",OF!Q3)"
    .Range("L3").AutoFill Destination:=WB1.Worksheets(Feuil3.Name).Range("L3:X3"), Type:=xlFillDefault
    .Range("L3:X3").AutoFill Destination:=WB1.Worksheets(Feuil3.Name).Range("L3:X" & x), Type:=xlFillDefault
    .Range("Y3") = "=IF(OF!BE3="""","""",OF!BE3)"
    .Range("Y3").AutoFill Destination:=WB1.Worksheets(Feuil3.Name).Range("Y3:AE3"), Type:=xlFillDefault
    .Range("Y3:AE3").AutoFill Destination:=WB1.Worksheets(Feuil3.Name).Range("Y3:AE" & x), Type:=xlFillDefault
    End With
    
    
    
    With WB1.Worksheets(Feuil4.Name)
    .Range("L3") = "=IF(OF!AG3="""","""",OF!AG3)"
    .Range("L3").AutoFill Destination:=WB1.Worksheets(Feuil4.Name).Range("L3:AI3"), Type:=xlFillDefault
    .Range("L3:AI3").AutoFill Destination:=WB1.Worksheets(Feuil4.Name).Range("L3:AI" & x), Type:=xlFillDefault
    End With
    
    With WB1.Worksheets(Feuil6.Name)
    .Range("L3") = "=IF(OF!AC3="""","""",OF!AC3)"
    .Range("L3").AutoFill Destination:=WB1.Worksheets(Feuil6.Name).Range("L3:O3"), Type:=xlFillDefault
    .Range("L3:O3").AutoFill Destination:=WB1.Worksheets(Feuil6.Name).Range("L3:O" & x), Type:=xlFillDefault
    End With
    
    With WB1.Worksheets(Feuil7.Name)
    .Range("L3") = "=IF(OF!BI3="""","""",OF!BI3)"
    .Range("L3").AutoFill Destination:=WB1.Worksheets(Feuil7.Name).Range("L3:O3"), Type:=xlFillDefault
    .Range("L3:O3").AutoFill Destination:=WB1.Worksheets(Feuil7.Name).Range("L3:O" & x), Type:=xlFillDefault
    End With

    
    With WB1.Worksheets(Feuil9.Name)
    .Range("CMS").Copy WB1.Worksheets(Feuil2.Name).Range("L1").End(xlUp).Offset(0, 0)
    .Range("FAB").Copy WB1.Worksheets(Feuil3.Name).Range("L1").End(xlUp).Offset(0, 0)
    .Range("TEST").Copy WB1.Worksheets(Feuil4.Name).Range("L1").End(xlUp).Offset(0, 0)
    .Range("ST").Copy WB1.Worksheets(Feuil6.Name).Range("L1").End(xlUp).Offset(0, 0)
    .Range("CTRLFIN").Copy WB1.Worksheets(Feuil7.Name).Range("L1").End(xlUp).Offset(0, 0)
    End With
    FABF = Right(WB1.Worksheets(Feuil9.Name).Range("FAB").Address(False, False), 3)
    CMSC = WB1.Worksheets(Feuil9.Name).Range("CMS").Columns.Count
    WB1.Worksheets(Feuil9.Name).Range("FABB").Copy WB1.Worksheets(Feuil3.Name).Range(FABF).End(xlUp).Offset(0, 1 - CMSC)
End Sub

PS:Je ne suis peut etre pas claire et je m'en excuse.
 

Pièces jointes

  • Classeur1.xlsm
    84.3 KB · Affichages: 48
  • OF.xlsx
    89.6 KB · Affichages: 166
  • Classeur1.xlsm
    84.3 KB · Affichages: 53
  • Classeur1.xlsm
    84.3 KB · Affichages: 53
Dernière édition:

Yaloo

XLDnaute Barbatruc
Re : Problème copier coller formule

Bonsoir Manu et bienvenu sur le forum,

Tu peux remplacer ça :

VB:
With WB1.Worksheets(Feuil2.Name)
    .Range("L3") = "=IF(OF!L3="""","""",OF!L3)"
    .Range("L3").AutoFill Destination:=WB1.Worksheets(Feuil2.Name).Range("L3:P3"), Type:=xlFillDefault
    .Range("L3:P3").AutoFill Destination:=WB1.Worksheets(Feuil2.Name).Range("L3:P" & x), Type:=xlFillDefault
    End With

Par

VB:
WB1.Feuil2.Range("L3:P" & x) = "=IF(OF!L3="""","""",OF!L3)"

Lorsque tu mets ....Offset(0, 0) ça correspond à la même ligne même colonne, ça ne sert donc à rien. Tu peux donc l'enlever sans problème.

Tu peux aussi remplacer tous les Worksheets(Feuil1.Name) par Feuil1 tu y gagnera en lisibilité.

A+

Martial
 

Manu57

XLDnaute Nouveau
Re : Problème copier coller formule

Je viens de tester le remplacement de tous les Worksheets(Feuil1.Name) par Feuil1 et lorsque je lance j'ai une erreur sur la ligne ou j'ai remplacé : Erreur d'exécution '438' : Propriété ou méthode non gérée par cet objet. Dans mon cas est-ce que je peux vraiment remplacer ?
 

Yaloo

XLDnaute Barbatruc
Re : Problème copier coller formule

Bonjour Manu,

Je me suis peut-être trompé en t'indiquant ce changement, ça n'a pas l'air de fonctionner lorsque l'on travaille sur des fichiers différents ou si l'on est pas sur le fichier actif. Désolé.

A+

Martial
 

Discussions similaires

Statistiques des forums

Discussions
312 971
Messages
2 094 046
Membres
105 927
dernier inscrit
rayade baali