Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" a écrit dans le message de news:
OE5%
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" <florian@toto.fr> a écrit dans le message de news:
OE5%23yHiuFHA.4032@TK2MSFTNGP15.phx.gbl...
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" a écrit dans le message de news:
OE5%
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Bonsoir Denis
Je te remercie pour ta célérité !
Je viens de tester
Petit problème lors du filtre :
With .Worksheets("La base").Range("A1").CurrentRegion
cela me filtre également la ligne A1 avec les entêtes
j'ai donc corrigé, et tout est nickel
Bravo !!!
Encore merci
Flo riant
"michdenis" a écrit dans le message de news:Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" a écrit dans le message de news:
OE5%
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Bonsoir Denis
Je te remercie pour ta célérité !
Je viens de tester
Petit problème lors du filtre :
With .Worksheets("La base").Range("A1").CurrentRegion
cela me filtre également la ligne A1 avec les entêtes
j'ai donc corrigé, et tout est nickel
Bravo !!!
Encore merci
Flo riant
"michdenis" <michdenis@hotmail.com> a écrit dans le message de news:
eKAEyhiuFHA.2512@TK2MSFTNGP10.phx.gbl...
Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" <florian@toto.fr> a écrit dans le message de news:
OE5%23yHiuFHA.4032@TK2MSFTNGP15.phx.gbl...
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Bonsoir Denis
Je te remercie pour ta célérité !
Je viens de tester
Petit problème lors du filtre :
With .Worksheets("La base").Range("A1").CurrentRegion
cela me filtre également la ligne A1 avec les entêtes
j'ai donc corrigé, et tout est nickel
Bravo !!!
Encore merci
Flo riant
"michdenis" a écrit dans le message de news:Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" a écrit dans le message de news:
OE5%
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Bonsoir Denis
Je te remercie pour ta célérité !
Je viens de tester
Petit problème lors du filtre :
With .Worksheets("La base").Range("A1").CurrentRegion
cela me filtre également la ligne A1 avec les entêtes
j'ai donc corrigé, et tout est nickel
Bravo !!!
Encore merci
Flo riant
"michdenis" a écrit dans le message de news:Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" a écrit dans le message de news:
OE5%
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Bonsoir Denis
Je te remercie pour ta célérité !
Je viens de tester
Petit problème lors du filtre :
With .Worksheets("La base").Range("A1").CurrentRegion
cela me filtre également la ligne A1 avec les entêtes
j'ai donc corrigé, et tout est nickel
Bravo !!!
Encore merci
Flo riant
"michdenis" <michdenis@hotmail.com> a écrit dans le message de news:
eKAEyhiuFHA.2512@TK2MSFTNGP10.phx.gbl...
Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" <florian@toto.fr> a écrit dans le message de news:
OE5%23yHiuFHA.4032@TK2MSFTNGP15.phx.gbl...
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Bonsoir Denis
Je te remercie pour ta célérité !
Je viens de tester
Petit problème lors du filtre :
With .Worksheets("La base").Range("A1").CurrentRegion
cela me filtre également la ligne A1 avec les entêtes
j'ai donc corrigé, et tout est nickel
Bravo !!!
Encore merci
Flo riant
"michdenis" a écrit dans le message de news:Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" a écrit dans le message de news:
OE5%
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Bonjour Florian,
Question 1 C'est cette ligne de code qui fait le travail
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
Question II Je ne saisis pas .... ta ligne d'étiquette est en ligne 1 ou
2
Une raison particulière de vouloir coder en dur Range("A2:T45000")
au lieu de currentregion ?
Salutations!
"Florian" a écrit dans le message de news:
%
Re Denis
Peux-tu me dire comment fais-tu pour coller les données ? cela fonctionne
mais, je ne vois pas comment
Egalement pour le filtre, j'ai mis :
With .Worksheets("La base").Range("A2:T45000")
à la place de :
With .Worksheets("La base").Range("A1").CurrentRegion
Flo riant
"Florian" a écrit dans le message de news:Bonsoir Denis
Je te remercie pour ta célérité !
Je viens de tester
Petit problème lors du filtre :
With .Worksheets("La base").Range("A1").CurrentRegion
cela me filtre également la ligne A1 avec les entêtes
j'ai donc corrigé, et tout est nickel
Bravo !!!
Encore merci
Flo riant
"michdenis" a écrit dans le message de news:Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" a écrit dans le message de news:
OE5%
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Bonjour Florian,
Question 1 C'est cette ligne de code qui fait le travail
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
Question II Je ne saisis pas .... ta ligne d'étiquette est en ligne 1 ou
2
Une raison particulière de vouloir coder en dur Range("A2:T45000")
au lieu de currentregion ?
Salutations!
"Florian" <florian@toto.fr> a écrit dans le message de news:
%23yML72iuFHA.596@TK2MSFTNGP12.phx.gbl...
Re Denis
Peux-tu me dire comment fais-tu pour coller les données ? cela fonctionne
mais, je ne vois pas comment
Egalement pour le filtre, j'ai mis :
With .Worksheets("La base").Range("A2:T45000")
à la place de :
With .Worksheets("La base").Range("A1").CurrentRegion
Flo riant
"Florian" <florian@toto.fr> a écrit dans le message de news:
epn63qiuFHA.2076@TK2MSFTNGP14.phx.gbl...
Bonsoir Denis
Je te remercie pour ta célérité !
Je viens de tester
Petit problème lors du filtre :
With .Worksheets("La base").Range("A1").CurrentRegion
cela me filtre également la ligne A1 avec les entêtes
j'ai donc corrigé, et tout est nickel
Bravo !!!
Encore merci
Flo riant
"michdenis" <michdenis@hotmail.com> a écrit dans le message de news:
eKAEyhiuFHA.2512@TK2MSFTNGP10.phx.gbl...
Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" <florian@toto.fr> a écrit dans le message de news:
OE5%23yHiuFHA.4032@TK2MSFTNGP15.phx.gbl...
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Bonjour Florian,
Question 1 C'est cette ligne de code qui fait le travail
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
Question II Je ne saisis pas .... ta ligne d'étiquette est en ligne 1 ou
2
Une raison particulière de vouloir coder en dur Range("A2:T45000")
au lieu de currentregion ?
Salutations!
"Florian" a écrit dans le message de news:
%
Re Denis
Peux-tu me dire comment fais-tu pour coller les données ? cela fonctionne
mais, je ne vois pas comment
Egalement pour le filtre, j'ai mis :
With .Worksheets("La base").Range("A2:T45000")
à la place de :
With .Worksheets("La base").Range("A1").CurrentRegion
Flo riant
"Florian" a écrit dans le message de news:Bonsoir Denis
Je te remercie pour ta célérité !
Je viens de tester
Petit problème lors du filtre :
With .Worksheets("La base").Range("A1").CurrentRegion
cela me filtre également la ligne A1 avec les entêtes
j'ai donc corrigé, et tout est nickel
Bravo !!!
Encore merci
Flo riant
"michdenis" a écrit dans le message de news:Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" a écrit dans le message de news:
OE5%
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Bonjour Florian,
Question 1 C'est cette ligne de code qui fait le travail
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
Question II Je ne saisis pas .... ta ligne d'étiquette est en ligne 1 ou
2
Une raison particulière de vouloir coder en dur Range("A2:T45000")
au lieu de currentregion ?
Salutations!
"Florian" a écrit dans le message de news:
%
Re Denis
Peux-tu me dire comment fais-tu pour coller les données ? cela fonctionne
mais, je ne vois pas comment
Egalement pour le filtre, j'ai mis :
With .Worksheets("La base").Range("A2:T45000")
à la place de :
With .Worksheets("La base").Range("A1").CurrentRegion
Flo riant
"Florian" a écrit dans le message de news:Bonsoir Denis
Je te remercie pour ta célérité !
Je viens de tester
Petit problème lors du filtre :
With .Worksheets("La base").Range("A1").CurrentRegion
cela me filtre également la ligne A1 avec les entêtes
j'ai donc corrigé, et tout est nickel
Bravo !!!
Encore merci
Flo riant
"michdenis" a écrit dans le message de news:Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" a écrit dans le message de news:
OE5%
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Bonjour Florian,
Question 1 C'est cette ligne de code qui fait le travail
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
Question II Je ne saisis pas .... ta ligne d'étiquette est en ligne 1 ou
2
Une raison particulière de vouloir coder en dur Range("A2:T45000")
au lieu de currentregion ?
Salutations!
"Florian" <florian@toto.fr> a écrit dans le message de news:
%23yML72iuFHA.596@TK2MSFTNGP12.phx.gbl...
Re Denis
Peux-tu me dire comment fais-tu pour coller les données ? cela fonctionne
mais, je ne vois pas comment
Egalement pour le filtre, j'ai mis :
With .Worksheets("La base").Range("A2:T45000")
à la place de :
With .Worksheets("La base").Range("A1").CurrentRegion
Flo riant
"Florian" <florian@toto.fr> a écrit dans le message de news:
epn63qiuFHA.2076@TK2MSFTNGP14.phx.gbl...
Bonsoir Denis
Je te remercie pour ta célérité !
Je viens de tester
Petit problème lors du filtre :
With .Worksheets("La base").Range("A1").CurrentRegion
cela me filtre également la ligne A1 avec les entêtes
j'ai donc corrigé, et tout est nickel
Bravo !!!
Encore merci
Flo riant
"michdenis" <michdenis@hotmail.com> a écrit dans le message de news:
eKAEyhiuFHA.2512@TK2MSFTNGP10.phx.gbl...
Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" <florian@toto.fr> a écrit dans le message de news:
OE5%23yHiuFHA.4032@TK2MSFTNGP15.phx.gbl...
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Bonjour Florian,
Question 1 C'est cette ligne de code qui fait le travail
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
Question II Je ne saisis pas .... ta ligne d'étiquette est en ligne 1 ou
2
Une raison particulière de vouloir coder en dur Range("A2:T45000")
au lieu de currentregion ?
Salutations!
"Florian" a écrit dans le message de news:
%
Re Denis
Peux-tu me dire comment fais-tu pour coller les données ? cela fonctionne
mais, je ne vois pas comment
Egalement pour le filtre, j'ai mis :
With .Worksheets("La base").Range("A2:T45000")
à la place de :
With .Worksheets("La base").Range("A1").CurrentRegion
Flo riant
"Florian" a écrit dans le message de news:Bonsoir Denis
Je te remercie pour ta célérité !
Je viens de tester
Petit problème lors du filtre :
With .Worksheets("La base").Range("A1").CurrentRegion
cela me filtre également la ligne A1 avec les entêtes
j'ai donc corrigé, et tout est nickel
Bravo !!!
Encore merci
Flo riant
"michdenis" a écrit dans le message de news:Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" a écrit dans le message de news:
OE5%
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Le offset(1) , c'est pour ne pas copier la ligne d'étiquette avec le reste
de la plage
Un autre exemple de syntaxe... tu ajoutes la fonction à un module standard
et tu peux utiliser ceci pour définir ta plage où aura lieu Autofilter.
With Wk
With .Worksheets("Feuil1").Range("A2:T" & DerLig(.Worksheets("Feuil1")))
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
.Item(2, 1).Select
End With
End With
End Sub
'----------------------
Function DerLig(sh As Worksheet)
On Error Resume Next
DerLig = sh.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
On Error GoTo 0
End Function
'----------------------
Salutations!
"Florian" a écrit dans le message de news:
%23mriN$
Je te remercie pour la précision
mais .Offset(1). pour toutes les lignes visibles ?
La ligne d'étiquettes est en 2 car j'ai les boutons macros en haut c'est à
dire en 1
il est vrai que parfois toutes les colonnes ne sont pas remplies mais
1,2,3,
toujours
Flo riant
"michdenis" a écrit dans le message de news:
u$Bonjour Florian,
Question 1 C'est cette ligne de code qui fait le travail
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
Question II Je ne saisis pas .... ta ligne d'étiquette est en ligne 1 ou
2
Une raison particulière de vouloir coder en dur Range("A2:T45000")
au lieu de currentregion ?
Salutations!
"Florian" a écrit dans le message de news:
%
Re Denis
Peux-tu me dire comment fais-tu pour coller les données ? cela fonctionne
mais, je ne vois pas comment
Egalement pour le filtre, j'ai mis :
With .Worksheets("La base").Range("A2:T45000")
à la place de :
With .Worksheets("La base").Range("A1").CurrentRegion
Flo riant
"Florian" a écrit dans le message de news:Bonsoir Denis
Je te remercie pour ta célérité !
Je viens de tester
Petit problème lors du filtre :
With .Worksheets("La base").Range("A1").CurrentRegion
cela me filtre également la ligne A1 avec les entêtes
j'ai donc corrigé, et tout est nickel
Bravo !!!
Encore merci
Flo riant
"michdenis" a écrit dans le message de news:Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" a écrit dans le message de news:
OE5%
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre
plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et
coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Le offset(1) , c'est pour ne pas copier la ligne d'étiquette avec le reste
de la plage
Un autre exemple de syntaxe... tu ajoutes la fonction à un module standard
et tu peux utiliser ceci pour définir ta plage où aura lieu Autofilter.
With Wk
With .Worksheets("Feuil1").Range("A2:T" & DerLig(.Worksheets("Feuil1")))
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
.Item(2, 1).Select
End With
End With
End Sub
'----------------------
Function DerLig(sh As Worksheet)
On Error Resume Next
DerLig = sh.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
On Error GoTo 0
End Function
'----------------------
Salutations!
"Florian" <florian@toto.fr> a écrit dans le message de news:
%23mriN$iuFHA.1264@TK2MSFTNGP12.phx.gbl...
Je te remercie pour la précision
mais .Offset(1). pour toutes les lignes visibles ?
La ligne d'étiquettes est en 2 car j'ai les boutons macros en haut c'est à
dire en 1
il est vrai que parfois toutes les colonnes ne sont pas remplies mais
1,2,3,
toujours
Flo riant
"michdenis" <michdenis@hotmail.com> a écrit dans le message de news:
u$lL06iuFHA.664@tk2msftngp13.phx.gbl...
Bonjour Florian,
Question 1 C'est cette ligne de code qui fait le travail
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
Question II Je ne saisis pas .... ta ligne d'étiquette est en ligne 1 ou
2
Une raison particulière de vouloir coder en dur Range("A2:T45000")
au lieu de currentregion ?
Salutations!
"Florian" <florian@toto.fr> a écrit dans le message de news:
%23yML72iuFHA.596@TK2MSFTNGP12.phx.gbl...
Re Denis
Peux-tu me dire comment fais-tu pour coller les données ? cela fonctionne
mais, je ne vois pas comment
Egalement pour le filtre, j'ai mis :
With .Worksheets("La base").Range("A2:T45000")
à la place de :
With .Worksheets("La base").Range("A1").CurrentRegion
Flo riant
"Florian" <florian@toto.fr> a écrit dans le message de news:
epn63qiuFHA.2076@TK2MSFTNGP14.phx.gbl...
Bonsoir Denis
Je te remercie pour ta célérité !
Je viens de tester
Petit problème lors du filtre :
With .Worksheets("La base").Range("A1").CurrentRegion
cela me filtre également la ligne A1 avec les entêtes
j'ai donc corrigé, et tout est nickel
Bravo !!!
Encore merci
Flo riant
"michdenis" <michdenis@hotmail.com> a écrit dans le message de news:
eKAEyhiuFHA.2512@TK2MSFTNGP10.phx.gbl...
Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" <florian@toto.fr> a écrit dans le message de news:
OE5%23yHiuFHA.4032@TK2MSFTNGP15.phx.gbl...
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre
plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et
coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
Le offset(1) , c'est pour ne pas copier la ligne d'étiquette avec le reste
de la plage
Un autre exemple de syntaxe... tu ajoutes la fonction à un module standard
et tu peux utiliser ceci pour définir ta plage où aura lieu Autofilter.
With Wk
With .Worksheets("Feuil1").Range("A2:T" & DerLig(.Worksheets("Feuil1")))
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
.Item(2, 1).Select
End With
End With
End Sub
'----------------------
Function DerLig(sh As Worksheet)
On Error Resume Next
DerLig = sh.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
On Error GoTo 0
End Function
'----------------------
Salutations!
"Florian" a écrit dans le message de news:
%23mriN$
Je te remercie pour la précision
mais .Offset(1). pour toutes les lignes visibles ?
La ligne d'étiquettes est en 2 car j'ai les boutons macros en haut c'est à
dire en 1
il est vrai que parfois toutes les colonnes ne sont pas remplies mais
1,2,3,
toujours
Flo riant
"michdenis" a écrit dans le message de news:
u$Bonjour Florian,
Question 1 C'est cette ligne de code qui fait le travail
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
Question II Je ne saisis pas .... ta ligne d'étiquette est en ligne 1 ou
2
Une raison particulière de vouloir coder en dur Range("A2:T45000")
au lieu de currentregion ?
Salutations!
"Florian" a écrit dans le message de news:
%
Re Denis
Peux-tu me dire comment fais-tu pour coller les données ? cela fonctionne
mais, je ne vois pas comment
Egalement pour le filtre, j'ai mis :
With .Worksheets("La base").Range("A2:T45000")
à la place de :
With .Worksheets("La base").Range("A1").CurrentRegion
Flo riant
"Florian" a écrit dans le message de news:Bonsoir Denis
Je te remercie pour ta célérité !
Je viens de tester
Petit problème lors du filtre :
With .Worksheets("La base").Range("A1").CurrentRegion
cela me filtre également la ligne A1 avec les entêtes
j'ai donc corrigé, et tout est nickel
Bravo !!!
Encore merci
Flo riant
"michdenis" a écrit dans le message de news:Bonjour Florian,
Ta procédure pourrait avoir l'air de ceci en principe ...
Je ne l'ai pas testée... mais tu vas le faire ?
Prend le temps de lire la procédure et de renseigner
adéquatement ce que j'ai souligné.
'-----------------------------------
Sub ModifierLiaison()
Dim Wk As Workbook
Dim MonClasseur As Workbook
Application.ScreenUpdating = False
Set MonClasseur = ActiveWorkbook
With Workbooks("NOmDuClasseur") ' à déterminer
Lenom = .Sheets("Liste").Range("A3").Value
End With
Set Wk = Workbooks.Open(Application.DefaultFilePath & _
"QuestionsLes statistiques.xls")
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.AutoFilter Field:=1, Criteria1:=Lenom
.Offset(1).SpecialCells(xlCellTypeVisible).Delete (xlUp)
.AutoFilter
End With
End With
With MonClasseur
'Quel est le vrai nom de la feuil1 dans ton application.
With .Worksheets("Feuil1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="<>"
.AutoFilter Field:=3, Criteria1:="<>"
.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
Wk.Worksheets("La base").Range("A65536").End(xlUp)(2)
End With
End With
With Wk
With .Worksheets("La base").Range("A1").CurrentRegion
.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
End With
.Save
.Close
End With
Set MonClasseur = Nothing: Set Wk = Nothing
End Sub
'-----------------------------------
Salutations!
"Florian" a écrit dans le message de news:
OE5%
Bonsoir
AnonymousA m'ayant conseillé d'optimiser mon code afin de le rendre
plus
lisible et sans doute plus rapide, j'ai essayé mais avec mes moyens
d'optimiser ce code, mais, c'est bancal ;-)
Pouvez-vous m'aider.
En fait il s'agit d'ouvrir un classeur qui se nomme "Les statistiques"
filtrer les lignes et les effacer selon un critère Le_nom, puis filtrer
sur
la feuille "Travail" du classeur en cours au départ, et copier et
coller
toutes les données filtrées, sur la feuille "La base" du classeur "Les
statistiques"
Je vous remercie beaucoup
Flo riant
Voici le code :
Application.ScreenUpdating = False
Set Monclasseur = ActiveWorkbook
Lenom = Sheets("Liste").Range("A3").Value
Workbooks.Open Application.DefaultFilePath & "Questions" & "Les
statistiques.xls "
With Workbooks("Les statistiques.xls")
Worksheets("La base").Range("A2:T50000").Select
Selection.AutoFilter Field:=1, Criteria1:=Lenom
Worksheets("La
base").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Select
Selection.ClearContents
Selection.AutoFilter
Worksheets("La base").Range("A3").Select
End With
Monclasseur.Activate
Range("A2:T5000").Select
Selection.AutoFilter Field:=2, Criteria1:="<>"
Selection.AutoFilter Field:=3, Criteria1:="<>"
Sheets("Travail").Range("A3:T5000").SpecialCells(xlCellTypeVisible).Copy
With Workbooks("Les statistiques.xls")
.Activate
Worksheets("La base").Range("A50000").End(xlUp)(2).Select
Worksheets("La base").Paste
Worksheets("La base").Range("A2:T50000").Select
Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes,
_
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom
Worksheets("La base").Range("A1").Select
End With
With Workbooks("Les statistiques.xls")
.Save
.Close
End With
Monclasseur.Activate
end if
Application.ScreenUpdating = True
