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.
Voila la partie ou je bloque
et voila le code entier
PS:Je ne suis peut etre pas claire et je m'en excuse.
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
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
Dernière édition: