VBA Macro Trop dur !! Help :)

Bianca49

XLDnaute Nouveau
Bonjour,

Je suis débutante en macro et j'ai quelques problèmes sur celle que je suis en train de réaliser pour le travail en ce moment.

Pour résumer ce que je dois faire :
1) Aller chercher une extract excel qui peut changer de nom mais qui sera toujours dans un même dossier
2) Copier cet extract en effectuant quelques modifications (à savoir que le nombre de ligne peut changer sur mon extract)
- Supprimer des colonnes
- supprimer des lignes
- Insérer des colonnes
- Déplacer des colonnes
- Mettre toujours la même valeur sur une colonne à partir de la deuxième ligne de cette colonne
- Mettre en jaune des lignes à partir d'une valeur que je retrouve dans une colonne
- Mettre tout une colonne en chiffre alors qu'elle est en texte
- Faire un tri et une rechercheV

Voilà mon code

PHP:
Sub PrePOMacro()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual

Dim fichier, fichierGSCM, fichiervaleur, PrePO, PrePO2, GSCM, tabvaleur, tabvaleur2, jour As String
Dim semainecherchee1, semainecherchee2, valeurcherchee1, valeurcherchee2, valeurremplacee1, valeurremplacee2 As String
Dim i, j, k, l, m, n, o As Long
Dim Extract As Worksheet

'Message de confirmation de lancement de la macro
If MsgBox("Effectuer la mise à jour PrePO ?", vbYesNo + vbQuestion, "Demande de confirmation") = vbYes Then

PrePO = ActiveWorkbook.Name

'Sélectionner le fichier GSCM
ChDrive ("S")
ChDir "S:\fichier"
fichierGSCM = Application.GetOpenFilename("Date,*.xls;*.xlsx", , "Sélectionner l'extraction GSCM")
Workbooks.OpenText Filename:=fichierGSCM
fichierGSCM = ActiveWorkbook.Name

'--------------------------------------------------

Windows(PrePO).Activate
'Onglet SAP, supprimer l'ancienne extract
Sheets("Extract").Select
On Error Resume Next
        Sheets("Extract").ShowAllData
        On Error GoTo 0
    Range("A1:AR1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    

    
Windows(PrePO).Activate
Sheets("Extract").Select
On Error Resume Next
        Sheets("Extract").ShowAllData
        On Error GoTo 0

    'Extract GSCM, mise en plage du tableau
    Columns("A:A").Select
    Columns("I:J").Select
    Columns("AJ:AR").Select
    Selection.Delete Shift:=xlToLeft
    
    Rows("1:1").Select
    Selection.Delete Shift:=xlToLeft
    
    Columns("A:A").Select
    Columns("C:E").Select
    Columns("I:I").Select
    Columns("K:Q").Select
    Columns("S:AG").Select
    Selection.Delete Shift:=xlToLeft
    
    
    Columns("BU:BV").Select
    Selection.Cut
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    
    Columns("H:H").Select
    Selection.Cut
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
    
    
        
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "SEF Request"
    
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Comments"
    
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Factory"
    
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "X"
    
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "Early Production"
    
'Mettre TV en colonne B
    
Windows(PrePO).Activate
    Sheets("Extract").Select
    Range("B2:B2").AutoFill Destination:=Range("B2:B" & Range("B65536").End(xlUp).Row)
    


 
 'Mettre en chiffre

Range("K2:K65536").Select
 Range("K2:K" & Range("A65536").End(xlUp).Row).FillDown
    ActiveWindow.SmallScroll Down:=-65536
    
Selection.Replace What:=",", Replacement:="", LookAt:=xlPart
    Selection.NumberFormat = "0"



    
' Mettre TV dans colonne

derniereLigne = Cells(Rows.Count, 1).End(xlUp).Row
    Range("B2:B65536").Select
    ActiveCell.FormulaR1C1 = "TV"
    
    Range("B2").Select
    Range("B2:B" & (derniereLigne) & "").Select

    Selection.FillDown
    Columns("B:B").Select
    Selection.Copy

'filte croissant des données

    Range("A1:K1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Extract").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Extract").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Extract").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply

    
' RechercheV

vDerligneSuc = Cells(Rows.Count, 1).End(xlUp).Row
    Range("I2:I65536").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6],Palettisation!C[-8]:C[20],29,FALSE)"


    
    Range("I2").Select
    Range("I2:I" & (vDerligneSuc) & "").Select

    Selection.FillDown
    Columns("I:I").Select
    Selection.Copy
    


        End With
    End If



End Sub

Je sais qu'il y a plein d'erreur, donc j'aurais besoin absolument d'aide !!
Si vous avez le temps de me répondre, ça me sauverait la vie !!
 

Modeste

XLDnaute Barbatruc
Re : VBA Macro Trop dur !! Help :)

Bonjour Bianca49 et bienvenue,

Si vous avez le temps de me répondre, ça me sauverait la vie !!
Voilà qui ne semble pas susciter un enthousiasme débordant :(
Pour ne pas avoir ce genre d'incident sur la conscience, il faut tout de même qu'on te dise: juste le code, sans le fichier source, c'est un peu la galère!

Et puis, on imagine qu'il y a des choses qui fonctionnent et d'autres ... moins, mais quoi, il faut qu'on devine!?
Si on prenait "un bout à la fois"? Quelle est la première difficulté rencontrée?
 

Discussions similaires

Réponses
3
Affichages
569

Statistiques des forums

Discussions
312 103
Messages
2 085 313
Membres
102 860
dernier inscrit
fredo67