Ajouter deux fonctions dans une marco

Le 11/05/2014 à 13:49

Bonjour,

J'ai créé une macro grâce à l'enregistrement de VBA mais je souhaiterai ajouter deux fonctions à celle-ci.

La macro permet de recupèrer des données dans une autre feuille, elle filtre, elle trie et ajoute avec la bonne mise en forme dans la feuille principal de mon doc excel.

1/

Cependant je souhaiterai ajouter une fonction qui permet de rajouter les informations à la suite dans ma feuille principal afin de pas effacer ce qui à déjà été copié précédement?

Ex :

A1 B1 (utilisées)

... ...

A10 B10 (utilisées)

A11 B11 (vides)

la macro ajoute les informations qu'elle va chercher à partir de la ligne car la ligne est vide.

J'ai trouvé ça sur le net mais pas moyen de l'adapter à la mienne..

Range("A1:E60000").Copy Range("A65536").End(xlUp).Offset(1, 0)

Voici la macro :

Sub ExtractiondonnéesSAP()

'

' ExtractiondonnéesSAP Macro

'

Sheets("FeuilleSAP").Select

'

Range("A:A,D:D,E:E,H:H,J:L,N:O").Select

Range("N1").Activate

Application.CutCopyMode = False

Selection.Delete Shift:=xlToLeft

Range("5:5,3:3,2:2,1:1").Select

Range("A1").Activate

Selection.Delete Shift:=xlUp

Columns("F:F").Select

Selection.Replace What:=".", Replacement:="/", LookAt:=xlPart, _

SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

ReplaceFormat:=False

Range("G2").Select

ActiveCell.FormulaR1C1 = "=RC[-1]*1"

Range("G2").Select

Selection.AutoFill Destination:=Range("G2:G39440")

Range("G2:G39440").Select

Range("A1:G1").Select

Selection.AutoFilter

ActiveSheet.Range("$A$1:$G$39440").AutoFilter Field:=5, Criteria1:="HOV1"

Range("A31:G31").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

Sheets("FeuilleSAP2 Ne pas utiliser").Select

ActiveWindow.SmallScroll Down:=-6

Range("A1").Select

ActiveSheet.Paste

ActiveWindow.SmallScroll Down:=-3

Columns("F:F").Select

Application.CutCopyMode = False

Selection.Delete Shift:=xlToLeft

Columns("E:E").Select

Selection.Delete Shift:=xlToLeft

Columns("A:E").Select

Range("E1").Activate

ActiveWorkbook.Worksheets("FeuilleSAP2 Ne pas utiliser").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("FeuilleSAP2 Ne pas utiliser").Sort.SortFields.Add _

Key:=Range("E1:E1717"), SortOn:=xlSortOnValues, Order:=xlAscending, _

DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("FeuilleSAP2 Ne pas utiliser").Sort

.SetRange Range("A1:E1717")

.Header = xlGuess

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

Columns("E:E").Select

Selection.NumberFormat = "m/d/yyyy"

Range("A1:E1").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

Sheets("Planning livraison").Select

Range("A7").Select

ActiveSheet.Paste

Application.CutCopyMode = False

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Range("A7").Select

Sheets("FeuilleSAP2 Ne pas utiliser").Select

Cells.Select

Range("A1696").Activate

Selection.Delete Shift:=xlUp

Sheets("FeuilleSAP").Select

ActiveSheet.Range("$A$1:$G$39440").AutoFilter Field:=5

Cells.Select

Selection.Delete Shift:=xlUp

Range("A1").Select

Sheets("Planning livraison").Select

End Sub

2/ Deuxième fonction que je souhaiterai ajouter :

Ma macro va chercher les informations comme ça : .SetRange Range("A1:E1717") hors il se peut que les prochaines données à extraire soit plus nombreuses et donc si la macro s'arrête à E1717, elle va oublier les lignes suivantes si je comprends bien la macro.

Est-il possible de demander à la macro d'aller chercher la dernière ligne utilisée ?

En vous remerciant d'avance de votre aide.

Repi17

Le 11/05/2014 à 15:22

Bonjour

Mets ton fichier (sans données confidentielles) en ligne ce sera plus simple.

Voici déjà une simplification de la 1ere partie ton code

Sub ExtractiondonnéesSAP()
' ExtractiondonnéesSAP Macro
'
Sheets("FeuilleSAP").Select
 Range("A:A,D:D,E:E,H:H,J:L,N:O").Delete Shift:=xlToLeft
 Range("5:5,3:3,2:2,1:1").Delete Shift:=xlUp
 Columns("F:F").Replace What:=".", Replacement:="/", LookAt:=xlPart, _
 SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
 ReplaceFormat:=False
 Range("G2").FormulaR1C1 = "=RC[-1]*1"
 Range("G2").AutoFill Destination:=Range("G2:G39440")
 'Range("G2:G39440").Select
 Range("A1:G1").AutoFilter
 Range("$A$1:$G$39440").AutoFilter Field:=5, Criteria1:="HOV1"
 Range("A31:G31").Select
 Range(Selection, Selection.End(xlDown)).Copy Sheets("FeuilleSAP2 Ne pas utiliser").Range("A1")
 Sheets("FeuilleSAP2 Ne pas utiliser").Select
 Columns("F:F").Delete Shift:=xlToLeft
 Columns("E:E").Delete Shift:=xlToLeft
 Columns("A:E").Select
 Worksheets("FeuilleSAP2 Ne pas utiliser").Sort.SortFields.Clear
 Worksheets("FeuilleSAP2 Ne pas utiliser").Sort.SortFields.Add _
 Key:=Range("E1:E1717"), SortOn:=xlSortOnValues, Order:=xlAscending, _
 DataOption:=xlSortNormal

 With ActiveWorkbook.Worksheets("FeuilleSAP2 Ne pas utiliser").Sort
 .SetRange Range("A1:E1717")
 .Header = xlGuess
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
.....

On peut faire mieux mais sans fichier ....

Amicalement

Le 11/05/2014 à 16:07

Le voilà.

Merci déjà pour la simplification (je l'ajouterai après)

Le 11/05/2014 à 17:03

Re

Pour la deuxième fonction et reprendre toutes les données --> Range("A1:E1717"), tu peux utiliser ceci

range("A1:E" & Range("A" & Rows.Count).End(xlUp).Row)

On suppose bien entendu que la colonne A est toujours bien complète

Pour la première fonction et l'ajout, il faudrait savoir comment tu fonctionnes une fois la macro 1 appliquée

crdlt

Le 11/05/2014 à 17:31

Donc à chaque fois que j'ai => Range("A1:E1717") ou 'Range("G2:G39440").Select, etc je dois remplacer par ton code (en changeant au besoin la lettre E par G) ?

La colonne A est toujours utilisée donc nickel.

Pour la première fonction :

Range("A1:E1").Select

Application.CutCopyMode = False

Je colle en A7 acutellement, c'est la que je voudrai ajouter la fonction qui cherche la dernière ligne dans la colonne A vide afin de coller à la suite sans écraser les données déjà copier/coller précédement.

Le 12/05/2014 à 08:23

Re

Donc à chaque fois que j'ai => Range("A1:E1717") ou 'Range("G2:G39440").Select, etc je dois remplacer par ton code (en changeant au besoin la lettre E par G) ?

Tu as effectivement bien compris. evidement cela suppose que A est toujours rempli. Le cas échéant, cela ne fonctionnera pas.

Pour ton deuxième souci, essaie comme ceci :

Range("A1:E" & Range("A" & Rows.Count).End(xlUp).Row).Copy _
Sheets("Planning livraison").Range("A" & Sheets("Planning livraison").Range("A" & Sheets("Planning livraison").Rows.Count).End(xlUp).Row + 1)

Si ok, clique sur le V vert à coté du bouton EDITER pour cloturer le fil lors de ta réponse

Amicalement

Le 13/05/2014 à 11:20

Cette partie fonctionne nickel !!! Merci

Range("A1:E" & Range("A" & Rows.Count).End(xlUp).Row).Copy _

Sheets("Planning livraison").Range("A" & Sheets("Planning livraison").Range("A" & Sheets("Planning livraison").Rows.Count).End(xlUp).Row + 1)

Concernant l'autre, j'ai un peu de mal à la mettre en place dans la macro.

' Activation Cellule x 1

Range("G2:G39440").Select

J'extrais donc mon document d'un logiciel, la colonne G me sert à activer les données qui se trouve colonne F (des dates) car elles sont sous format texte. Une fois que je fais date*1, je lui demande d'étirer.

Dans je mets range("A1:G" & Range("A" & Rows.Count).End(xlUp).Row) à la place de Range("G2:G39440") et la il plante.

Tu as une idée ? stp

merci

Le 14/05/2014 à 12:50

Re,

Essaie ceci :

With Range("G2")
    .FormulaR1C1 = "=RC[-1]*1"
    .AutoFill Destination:=Range("G2:G" & Range("A" & Rows.Count).End(xlUp).Row)
End With

Amicalement

Rechercher des sujets similaires à "ajouter deux fonctions marco"