Modification de macroS pour quelles puisses se "combiner"

S

Sobas

XLDnaute Nouveau
Bonjour a tous, voilà,
J'ai trouver cette macro de Roland sur ce forum (https://www.excel-downloads.com/threads/macro-pour-tous-les-fichiers-dun-dossier.133768/) qui permet d’effectuer en boucle une macro de tout les fichiers d'un dossier cible choisi. Je voudrais remplacer la macro qui est effectué en boucle par la mienne.

Voici la macro permettant le traitement en boucle, il me semble qu'a partir de (Private Sub Test(), il s'agit de la macro a exécuter en boucle:

PHP: 
    Public Chemin, Fich As String, ReponseMsgBox As Variant

    '                                           .
    'routine d'appel depuis le bouton sur feuille
    '                                           .
    Public Sub SelectionnerRepertoire()
    Chemin = FLoadNomDuREP: Chemin = Trim(Chemin): If Chemin = "" Then Exit Sub
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
    DoEvents
    'demande de confirmation
    M$ = "Traiter tous les Fichiers xls du répertoire suivant :" & vbLf & Chemin & vbLf & vbLf & "Veuillez confirmer ?"
    ReponseMsgBox = MsgBox(M$, vbQuestion + vbYesNo, "Traitement des fichiers")
    If ReponseMsgBox = vbYes Then
       BoucleDeTraitement ' appel la routine de traitement des fichiers
      MsgBox "Traitement terminé !", vbInformation
    Else
       MsgBox "Traitement abandonné !", vbExclamation
    End If
    End Sub

    ' , &H1&)=avec bouton "créer un nouveau dossier" ... , $H201&)=sans le bouton
    'objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&, RepDefaut)
    Private Function FLoadNomDuREP() As String
    Dim objShell As Object, objFolder As Object, REP As String
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&)
    If Not objFolder Is Nothing Then
       REP = objFolder.Items.Item.Path
       If Right(REP, 1) <> "\" Then REP = REP & "\"
    End If
    FLoadNomDuREP = REP
    Set objShell = Nothing: Set objFolder = Nothing
    End Function

    '                                                                               .
    '                                                                               .

    Private Sub BoucleDeTraitement() ' la boucle de traitement des fichiers
    Application.ScreenUpdating = False
    ChDir Chemin
    Fich = Dir(Chemin & "*.xls")
    Do While Fich <> ""
      Workbooks.Open Chemin & Fich
      Test
      ActiveWorkbook.Close True
      Fich = Dir
    Loop
    Application.ScreenUpdating = True
    End Sub

    Private Sub Test()
    'tous idem sur ActiveSheet.Cells
    SousProgTest "Slope"
    SousProgTest "Y-Intercept"
    SousProgTest "R^2"
    'celui-ci différent sur ActiveSheet.Range("A:A")
    Dim cellRecherche As Range
    Set cellRecherche = ActiveSheet.Range("A:A").Find("Well", , , xlPart)
    While Not cellRecherche Is Nothing
     cellRecherche.EntireRow.Delete
     Set cellRecherche = ActiveSheet.Range("A:A").Find("Well", , , xlPart)
    Wend
    '
    Application.Run "efface_ligne_vide"
    End Sub

    Private Sub SousProgTest(R$)
    Dim cellRecherche As Range
    Set cellRecherche = ActiveSheet.Cells.Find(R$, , , xlPart)
    While Not cellRecherche Is Nothing
    cellRecherche.EntireRow.Delete
    Set cellRecherche = ActiveSheet.Cells.Find(R$, , , xlPart)
    Wend
    End Sub

    Private Sub Efface_Ligne_Vide()
    Dim l As Long
    For l = Cells(65256, 1).End(xlUp).Row To 1 Step -1
     If Cells(l, 1).Value = "" Then Cells(l, 1).EntireRow.Delete
    Next l
    Range("A9:F392").Select: Range("F392").Activate
    Selection.Sort Key1:=Range("A9"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

    Cells.Select: Range("H36").Activate
    Selection.Replace What:="Undetermined", Replacement:="40", LookAt:=xlPart _
    , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    Application.DisplayAlerts = False
    SaveName = ActiveWorkbook.Name
    ActiveWorkbook.SaveAs Filename:="Cla_" & SaveName, FileFormat:=xlText, CreateBackup:=False
    Application.DisplayAlerts = True
    End Sub

Et voici ma macro:
PHP: 
    Sub traduction_données_brutes()
    '
    ' traduction_données_brutes_étape1 Macro
    '
    ' Touche de raccourci du clavier: Ctrl+q
    '
       Columns("F:G").Select
        Selection.ClearContents
        Rows("1:1").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A1").Select
        ActiveCell.FormulaR1C1 = "DATE"
        Range("B1").Select
        ActiveCell.FormulaR1C1 = "HEUR"
        Range("C1").Select
        ActiveCell.FormulaR1C1 = "TEMPS ECOULE"
        Range("D1").Select
        ActiveCell.FormulaR1C1 = "SUBJECT"
        Range("E1").Select
        ActiveCell.FormulaR1C1 = "OBS"
        Range("A1:E1").Select
        With Selection.Font
            .Color = -16776961
            .TintAndShade = 0
        End With
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThick
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThick
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThick
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThick
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThick
        End With
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        Cells.Select
        Range("G12").Activate
        Selection.Copy
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Paste
        Range("F2").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]"
        Range("F2").Select
        Selection.AutoFill Destination:=Range("F2:F30795"), Type:=xlFillDefault
        Range("F2:F30795").Select
        ActiveWindow.ScrollRow = 30649
        ActiveWindow.ScrollRow = 30527
        ActiveWindow.ScrollRow = 30284
        ActiveWindow.ScrollRow = 30042
        ActiveWindow.ScrollRow = 29799
        ActiveWindow.ScrollRow = 29435
        ActiveWindow.ScrollRow = 28949
        ActiveWindow.ScrollRow = 28403
        ActiveWindow.ScrollRow = 27857
        ActiveWindow.ScrollRow = 27250
        ActiveWindow.ScrollRow = 26461
        ActiveWindow.ScrollRow = 25733
        ActiveWindow.ScrollRow = 24823
        ActiveWindow.ScrollRow = 23973
        ActiveWindow.ScrollRow = 23063
        ActiveWindow.ScrollRow = 21970
        ActiveWindow.ScrollRow = 20938
        ActiveWindow.ScrollRow = 19725
        ActiveWindow.ScrollRow = 18572
        ActiveWindow.ScrollRow = 17540
        ActiveWindow.ScrollRow = 16630
        ActiveWindow.ScrollRow = 15841
        ActiveWindow.ScrollRow = 14930
        ActiveWindow.ScrollRow = 14141
        ActiveWindow.ScrollRow = 13292
        ActiveWindow.ScrollRow = 12503
        ActiveWindow.ScrollRow = 11835
        ActiveWindow.ScrollRow = 11107
        ActiveWindow.ScrollRow = 10500
        ActiveWindow.ScrollRow = 9893
        ActiveWindow.ScrollRow = 9286
        ActiveWindow.ScrollRow = 8740
        ActiveWindow.ScrollRow = 8315
        ActiveWindow.ScrollRow = 7830
        ActiveWindow.ScrollRow = 7405
        ActiveWindow.ScrollRow = 7102
        ActiveWindow.ScrollRow = 6737
        ActiveWindow.ScrollRow = 6434
        ActiveWindow.ScrollRow = 6070
        ActiveWindow.ScrollRow = 5827
        ActiveWindow.ScrollRow = 5524
        ActiveWindow.ScrollRow = 5281
        ActiveWindow.ScrollRow = 5038
        ActiveWindow.ScrollRow = 4735
        ActiveWindow.ScrollRow = 4492
        ActiveWindow.ScrollRow = 4310
        ActiveWindow.ScrollRow = 4067
        ActiveWindow.ScrollRow = 3824
        ActiveWindow.ScrollRow = 3582
        ActiveWindow.ScrollRow = 3400
        ActiveWindow.ScrollRow = 3217
        ActiveWindow.ScrollRow = 2975
        ActiveWindow.ScrollRow = 2793
        ActiveWindow.ScrollRow = 2671
        ActiveWindow.ScrollRow = 2489
        ActiveWindow.ScrollRow = 2368
        ActiveWindow.ScrollRow = 2186
        ActiveWindow.ScrollRow = 2064
        ActiveWindow.ScrollRow = 1882
        ActiveWindow.ScrollRow = 1761
        ActiveWindow.ScrollRow = 1579
        ActiveWindow.ScrollRow = 1458
        ActiveWindow.ScrollRow = 1336
        ActiveWindow.ScrollRow = 1215
        ActiveWindow.ScrollRow = 1093
        ActiveWindow.ScrollRow = 972
        ActiveWindow.ScrollRow = 790
        ActiveWindow.ScrollRow = 669
        ActiveWindow.ScrollRow = 547
        ActiveWindow.ScrollRow = 426
        ActiveWindow.ScrollRow = 304
        ActiveWindow.ScrollRow = 183
        ActiveWindow.ScrollRow = 62
        ActiveWindow.ScrollRow = 1
        Range("D2").Select
        Selection.Copy
        Range("L2").Select
        ActiveSheet.Paste
        Range("L2").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = " Subject0"
        Range("E2").Select
        Selection.Copy
        Range("M2").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = " Obs0"
        Range("L2").Select
        Selection.AutoFill Destination:=Range("L2:L11"), Type:=xlFillDefault
        Range("L2:L11").Select
        Range("M2").Select
        Selection.AutoFill Destination:=Range("M2:M9"), Type:=xlFillDefault
        Range("M2:M9").Select
        Range("M2:M9").Select
        Selection.Copy
        Range("M10").Select
        ActiveSheet.Paste
        Range("M18").Select
        ActiveSheet.Paste
        ActiveWindow.SmallScroll Down:=10
        Range("M26").Select
        ActiveSheet.Paste
        ActiveWindow.SmallScroll Down:=10
        Range("M34").Select
        ActiveSheet.Paste
        Range("M42").Select
        ActiveSheet.Paste
        ActiveWindow.SmallScroll Down:=15
        Range("M50").Select
        ActiveSheet.Paste
        Range("M58").Select
        ActiveSheet.Paste
        ActiveWindow.SmallScroll Down:=15
        Range("M66").Select
        ActiveSheet.Paste
        ActiveWindow.SmallScroll Down:=-80
        Range("L3:L11").Select
        Application.CutCopyMode = False
        Selection.Cut
        Range("L11").Select
        ActiveSheet.Paste
        Range("L2").Select
        Selection.Copy
        Range("L3").Select
        ActiveSheet.Paste
        Range("L2:L3").Select
        Application.CutCopyMode = False
        Selection.AutoFill Destination:=Range("L2:L10"), Type:=xlFillDefault
        Range("L2:L10").Select
        Range("L12:L19").Select
        Selection.Cut
        Range("L18").Select
        ActiveSheet.Paste
        Range("L11").Select
        Selection.Copy
        Range("L12").Select
        ActiveSheet.Paste
        Range("L11:L12").Select
        Application.CutCopyMode = False
        Selection.AutoFill Destination:=Range("L11:L17"), Type:=xlFillDefault
        Range("L11:L17").Select
        ActiveWindow.SmallScroll Down:=5
        Range("L19").Select
        ActiveCell.FormulaR1C1 = " Subject2"
        Range("L18:L19").Select
        Selection.AutoFill Destination:=Range("L18:L26"), Type:=xlFillDefault
        Range("L18:L26").Select
        Range("L26").Select
        ActiveCell.FormulaR1C1 = " Subject3"
        Range("L26").Select
        Selection.Copy
        Range("L27").Select
        ActiveSheet.Paste
        Range("L26").Select
        ActiveWindow.SmallScroll Down:=5
        Range("L26:L27").Select
        Application.CutCopyMode = False
        Selection.AutoFill Destination:=Range("L26:L34"), Type:=xlFillDefault
        Range("L26:L34").Select
        Range("L34").Select
        ActiveCell.FormulaR1C1 = " Subject4"
        Range("L20").Select
        ActiveWindow.SmallScroll Down:=20
        Range("L34").Select
        Selection.Copy
        Range("L35").Select
        ActiveSheet.Paste
        Range("L34:L35").Select
        Application.CutCopyMode = False
        Selection.AutoFill Destination:=Range("L34:L42"), Type:=xlFillDefault
        Range("L34:L42").Select
        Range("L42").Select
        ActiveCell.FormulaR1C1 = " Subject5"
        Range("L42").Select
        Selection.Copy
        Range("L43").Select
        ActiveSheet.Paste
        Range("L42:L43").Select
        ActiveWindow.SmallScroll Down:=15
        Application.CutCopyMode = False
        Selection.AutoFill Destination:=Range("L42:L50"), Type:=xlFillDefault
        Range("L42:L50").Select
        Range("L50").Select
        ActiveCell.FormulaR1C1 = " Subject6"
        Range("L50").Select
        Selection.Copy
        Range("L51").Select
        ActiveSheet.Paste
        Range("L50:L51").Select
        Application.CutCopyMode = False
        Selection.AutoFill Destination:=Range("L50:L58"), Type:=xlFillDefault
        Range("L50:L58").Select
        Range("L58").Select
        ActiveCell.FormulaR1C1 = " Subject7"
        Range("L58").Select
        Selection.Copy
        Range("L59").Select
        ActiveSheet.Paste
        Range("L58:L59").Select
        ActiveWindow.SmallScroll Down:=10
        Application.CutCopyMode = False
        Selection.AutoFill Destination:=Range("L58:L66"), Type:=xlFillDefault
        Range("L58:L66").Select
        Range("L66").Select
        ActiveCell.FormulaR1C1 = " Subject8"
        Range("L66").Select
        Selection.Copy
        Range("L67").Select
        ActiveSheet.Paste
        Range("L66:L67").Select
        ActiveWindow.SmallScroll Down:=10
        Application.CutCopyMode = False
        Selection.AutoFill Destination:=Range("L66:L73"), Type:=xlFillDefault
        Range("L66:L73").Select
        Range("M66:M73").Select
        Selection.Copy
        Range("M74").Select
        ActiveSheet.Paste
        Range("L73").Select
        Application.CutCopyMode = False
        Selection.Copy
        Range("L74").Select
        ActiveSheet.Paste
        Range("L74").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = " Subject9"
        Range("L74").Select
        Selection.Copy
        Range("L75").Select
        ActiveSheet.Paste
        Range("L74:L75").Select
        Application.CutCopyMode = False
        Selection.AutoFill Destination:=Range("L74:L81"), Type:=xlFillDefault
        Range("L74:L81").Select
        ActiveWindow.SmallScroll Down:=-95
        Range("N2").Select
        ActiveCell.FormulaR1C1 = "D"
        Range("N3").Select
        ActiveCell.FormulaR1C1 = "R"
        Range("N4").Select
        ActiveCell.FormulaR1C1 = "AFFI"
        Range("N5").Select
        ActiveCell.FormulaR1C1 = "CLINEX"
        Range("N6").Select
        ActiveCell.FormulaR1C1 = "MONO"
        Range("N7").Select
        ActiveCell.FormulaR1C1 = "M20"
        Range("N8").Select
        ActiveCell.FormulaR1C1 = "274"
        Range("N9").Select
        ActiveCell.FormulaR1C1 = "360"
        Range("N10").Select
        ActiveCell.FormulaR1C1 = "ET"
        Range("N11").Select
        ActiveCell.FormulaR1C1 = "MORDRE"
        Range("N12").Select
        ActiveCell.FormulaR1C1 = "SG"
        Range("N13").Select
        ActiveCell.FormulaR1C1 = "KO"
        Range("N14").Select
        ActiveCell.FormulaR1C1 = "G403"
        Range("N15").Select
        ActiveCell.FormulaR1C1 = "NEZ"
        Range("N16").Select
        ActiveCell.FormulaR1C1 = "277"
        Range("N17").Select
        ActiveCell.FormulaR1C1 = "PUNK"
        Range("N18").Select
        ActiveCell.FormulaR1C1 = "FO"
        Range("N19").Select
        ActiveCell.FormulaR1C1 = "PRESENT"
        Range("N20").Select
        ActiveCell.FormulaR1C1 = "DEF"
        Range("N21").Select
        ActiveCell.FormulaR1C1 = "ZORO"
        Range("N22").Select
        ActiveCell.FormulaR1C1 = "LIPS"
        Range("N23").Select
        ActiveCell.FormulaR1C1 = "P40"
        Range("N24").Select
        ActiveCell.FormulaR1C1 = "EPIS"
        Range("N25").Select
        ActiveCell.FormulaR1C1 = "G400"
        Range("N26").Select
        ActiveCell.FormulaR1C1 = "VOC"
        Range("N27").Select
        ActiveCell.FormulaR1C1 = "GENITAL"
        Range("N28").Select
        ActiveCell.FormulaR1C1 = "BB"
        Range("N29").Select
        ActiveCell.FormulaR1C1 = "2F"
        Range("N30").Select
        ActiveCell.FormulaR1C1 = "BOITE"
        Range("N31").Select
        ActiveCell.FormulaR1C1 = "E66"
        Range("N32").Select
        ActiveCell.FormulaR1C1 = "ZORO"
        Range("N33").Select
        ActiveCell.FormulaR1C1 = "MARILIN"
        Range("N34").Select
        ActiveCell.FormulaR1C1 = "MIMIC"
        Range("N35").Select
        ActiveCell.FormulaR1C1 = "MONTE"
        Range("N36").Select
        ActiveCell.FormulaR1C1 = "COPU"
        Range("N37").Select
        ActiveCell.FormulaR1C1 = "COJAK"
        Range("N38").Select
        ActiveCell.FormulaR1C1 = "ARTHUR"
        Range("N39").Select
        ActiveCell.FormulaR1C1 = "160"
        Range("N40").Select
        ActiveCell.FormulaR1C1 = "A330"
        Range("N41").Select
        ActiveCell.FormulaR1C1 = "K431"
        Range("N42").Select
        ActiveCell.FormulaR1C1 = "CHARGE"
        Range("N43").Select
        ActiveCell.FormulaR1C1 = "ATAQ"
        Range("N44").Select
        ActiveCell.FormulaR1C1 = "VOISIN"
        Range("N45").Select
        ActiveCell.FormulaR1C1 = "ALPHA"
        Range("N46").Select
        ActiveCell.FormulaR1C1 = "VIN"
        Range("N47").Select
        ActiveCell.FormulaR1C1 = "2L"
        Range("N48").Select
        ActiveCell.FormulaR1C1 = "NEIG"
        Range("N49").Select
        ActiveCell.FormulaR1C1 = "L11"
        Range("N50").Select
        ActiveCell.FormulaR1C1 = "SUP"
        Range("N51").Select
        ActiveCell.FormulaR1C1 = "ALOG"
        Range("N52").Select
        ActiveCell.FormulaR1C1 = "FLIP"
        Range("N53").Select
        ActiveCell.FormulaR1C1 = "MERT"
        Range("N54").Select
        ActiveCell.FormulaR1C1 = "BOITE"
        Range("N55").Select
        ActiveCell.FormulaR1C1 = "NARINE"
        Range("N56").Select
        ActiveCell.FormulaR1C1 = "MARILIN"
        Range("N57").Select
        ActiveCell.FormulaR1C1 = "M21"
        Range("N58").Select
        ActiveCell.FormulaR1C1 = "POUR"
        Range("N59").Select
        ActiveCell.FormulaR1C1 = "JOUER"
        Range("N60").Select
        ActiveCell.FormulaR1C1 = "ALDO"
        Range("N61").Select
        ActiveCell.FormulaR1C1 = "DIGIT"
        Range("N62").Select
        ActiveCell.FormulaR1C1 = "PELE"
        Range("N63").Select
        ActiveCell.FormulaR1C1 = "203"
        Range("N64").Select
        ActiveCell.FormulaR1C1 = "ALPHAF"
        Range("N65").Select
        ActiveCell.FormulaR1C1 = "O30"
        Range("N66").Select
        ActiveCell.FormulaR1C1 = "FRAPER"
        Range("N67").Select
        ActiveCell.FormulaR1C1 = "REPOC"
        Range("N68").Select
        ActiveCell.FormulaR1C1 = "FK"
        Range("N69").Select
        ActiveCell.FormulaR1C1 = "QAZI"
        Range("N70").Select
        ActiveCell.FormulaR1C1 = "L10"
        Range("N71").Select
        ActiveCell.FormulaR1C1 = "PP"
        Range("N72").Select
        ActiveCell.FormulaR1C1 = "DIANA"
        Range("N73").Select
        ActiveCell.FormulaR1C1 = "FOFOL"
        Range("N74").Select
        ActiveCell.FormulaR1C1 = "ATRAPER"
        Range("N75").Select
        ActiveCell.FormulaR1C1 = "TRYADE"
        Range("N76").Select
        ActiveCell.FormulaR1C1 = "REMS"
        Range("N77").Select
        ActiveCell.FormulaR1C1 = "FRER"
        Range("N78").Select
        ActiveCell.FormulaR1C1 = "AL"
        Range("N79").Select
        ActiveCell.FormulaR1C1 = "PIRAT"
        Range("N80").Select
        ActiveCell.FormulaR1C1 = "2T"
        Range("N81").Select
        ActiveCell.FormulaR1C1 = "STOP"
        Range("N82").Select
        Application.WindowState = xlMinimized
        Application.WindowState = xlNormal
        ActiveWindow.SmallScroll Down:=-85
        Range("G2").Select
        ActiveCell.FormulaR1C1 = _
            "=IF(ISNA(VLOOKUP(RC[-3]&RC[-2],R2C13:R81C14,2,FALSE)),"""",VLOOKUP(RC[-3]&RC[-2],R2C13:R81C14,2,FALSE))"
        Range("L2:M81").Select
        Selection.Cut
        ActiveWindow.SmallScroll Down:=-20
        Range("K2").Select
        ActiveSheet.Paste
        Range("M2").Select
        ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]"
        Range("M2").Select
        Selection.AutoFill Destination:=Range("M2:M81"), Type:=xlFillDefault
        Range("M2:M81").Select
        ActiveWindow.SmallScroll Down:=-95
        Range("G2").Select
        ActiveCell.FormulaR1C1 = _
            "=IF(ISNA(VLOOKUP(RC[-3]&RC[-2],R2C12:R81C14,2,FALSE)),"""",VLOOKUP(RC[-3]&RC[-2],R2C12:R81C14,2,FALSE))"
        Range("G2").Select
        ActiveCell.FormulaR1C1 = _
            "=IF(ISNA(VLOOKUP(RC[-3]&RC[-2],R2C13:R81C14,2,FALSE)),"""",VLOOKUP(RC[-3]&RC[-2],R2C13:R81C14,2,FALSE))"
        Range("G2").Select
        Selection.AutoFill Destination:=Range("G2:G44285"), Type:=xlFillDefault
        Range("G2:G44285").Select
        ActiveWindow.SmallScroll Down:=-30
        ActiveWindow.ScrollRow = 44259
        ActiveWindow.ScrollRow = 44172
        ActiveWindow.ScrollRow = 44084
        ActiveWindow.ScrollRow = 43910
        ActiveWindow.ScrollRow = 43823
        ActiveWindow.ScrollRow = 43561
        ActiveWindow.ScrollRow = 43211
        ActiveWindow.ScrollRow = 42950
        ActiveWindow.ScrollRow = 42600
        ActiveWindow.ScrollRow = 42077
        ActiveWindow.ScrollRow = 41466
        ActiveWindow.ScrollRow = 40942
        ActiveWindow.ScrollRow = 40243
        ActiveWindow.ScrollRow = 39458
        ActiveWindow.ScrollRow = 38672
        ActiveWindow.ScrollRow = 37887
        ActiveWindow.ScrollRow = 36926
        ActiveWindow.ScrollRow = 36053
        ActiveWindow.ScrollRow = 35006
        ActiveWindow.ScrollRow = 34046
        ActiveWindow.ScrollRow = 32911
        ActiveWindow.ScrollRow = 31863
        ActiveWindow.ScrollRow = 30641
        ActiveWindow.ScrollRow = 29419
        ActiveWindow.ScrollRow = 28284
        ActiveWindow.ScrollRow = 27149
        ActiveWindow.ScrollRow = 25927
        ActiveWindow.ScrollRow = 24705
        ActiveWindow.ScrollRow = 23658
        ActiveWindow.ScrollRow = 22610
        ActiveWindow.ScrollRow = 21388
        ActiveWindow.ScrollRow = 20340
        ActiveWindow.ScrollRow = 19206
        ActiveWindow.ScrollRow = 17896
        ActiveWindow.ScrollRow = 16849
        ActiveWindow.ScrollRow = 15539
        ActiveWindow.ScrollRow = 14317
        ActiveWindow.ScrollRow = 13182
        ActiveWindow.ScrollRow = 12135
        ActiveWindow.ScrollRow = 11000
        ActiveWindow.ScrollRow = 9865
        ActiveWindow.ScrollRow = 8730
        ActiveWindow.ScrollRow = 7770
        ActiveWindow.ScrollRow = 6548
        ActiveWindow.ScrollRow = 5675
        ActiveWindow.ScrollRow = 4802
        ActiveWindow.ScrollRow = 4017
        ActiveWindow.ScrollRow = 3318
        ActiveWindow.ScrollRow = 2620
        ActiveWindow.ScrollRow = 2009
        ActiveWindow.ScrollRow = 1310
        ActiveWindow.ScrollRow = 699
        ActiveWindow.ScrollRow = 263
        ActiveWindow.ScrollRow = 1



    ' Traduction_suite_et_fin Macro

    ' Touche de raccourci du clavier: Ctrl+d

        Range("A1:G155").Select
        ActiveWindow.ScrollRow = 176
        ActiveWindow.ScrollRow = 88
        ActiveWindow.ScrollRow = 1
        Columns("A:G").Select
        Selection.Copy
        Sheets.Add After:=Sheets(Sheets.Count)
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Columns("D:F").Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlToLeft
        Range("H5").Select
        Sheets("Feuil1").Select
        Columns("A:A").Select
        Selection.Copy
        Sheets("Feuil2").Select
        Columns("A:A").Select
        ActiveSheet.Paste
        Range("F8").Select



    ' Modification_du_temps Macro
    '
    ' Touche de raccourci du clavier: Ctrl+f
    '
       Range("E2").Select
        ActiveCell.FormulaR1C1 = "=TIMEVALUE(RC[-3])-TEMPSVAL5"
        Range("E2").Select
        ActiveCell.FormulaR1C1 = "=TIMEVALUE(RC[-3])-TIMEVALUE(R2C[-3])"
        Range("E2").Select
        Selection.AutoFill Destination:=Range("E2:E68468"), Type:=xlFillDefault
        Range("E2:E68468").Select
        ActiveWindow.ScrollRow = 68173
        ActiveWindow.ScrollRow = 67768
        ActiveWindow.ScrollRow = 67363
        ActiveWindow.ScrollRow = 66553
        ActiveWindow.ScrollRow = 65743
        ActiveWindow.ScrollRow = 64663
        ActiveWindow.ScrollRow = 63583
        ActiveWindow.ScrollRow = 62233
        ActiveWindow.ScrollRow = 60748
        ActiveWindow.ScrollRow = 59128
        ActiveWindow.ScrollRow = 57373
        ActiveWindow.ScrollRow = 55619
        ActiveWindow.ScrollRow = 53999
        ActiveWindow.ScrollRow = 52109
        ActiveWindow.ScrollRow = 50219
        ActiveWindow.ScrollRow = 48464
        ActiveWindow.ScrollRow = 46574
        ActiveWindow.ScrollRow = 44819
        ActiveWindow.ScrollRow = 43199
        ActiveWindow.ScrollRow = 41714
        ActiveWindow.ScrollRow = 40364
        ActiveWindow.ScrollRow = 39014
        ActiveWindow.ScrollRow = 37664
        ActiveWindow.ScrollRow = 36179
        ActiveWindow.ScrollRow = 34694
        ActiveWindow.ScrollRow = 33345
        ActiveWindow.ScrollRow = 31860
        ActiveWindow.ScrollRow = 30510
        ActiveWindow.ScrollRow = 28890
        ActiveWindow.ScrollRow = 27540
        ActiveWindow.ScrollRow = 26190
        ActiveWindow.ScrollRow = 24705
        ActiveWindow.ScrollRow = 23490
        ActiveWindow.ScrollRow = 22140
        ActiveWindow.ScrollRow = 20925
        ActiveWindow.ScrollRow = 19575
        ActiveWindow.ScrollRow = 18225
        ActiveWindow.ScrollRow = 17145
        ActiveWindow.ScrollRow = 16065
        ActiveWindow.ScrollRow = 15120
        ActiveWindow.ScrollRow = 14310
        ActiveWindow.ScrollRow = 13500
        ActiveWindow.ScrollRow = 12960
        ActiveWindow.ScrollRow = 12420
        ActiveWindow.ScrollRow = 11880
        ActiveWindow.ScrollRow = 11341
        ActiveWindow.ScrollRow = 10936
        ActiveWindow.ScrollRow = 10531
        ActiveWindow.ScrollRow = 9991
        ActiveWindow.ScrollRow = 9721
        ActiveWindow.ScrollRow = 9181
        ActiveWindow.ScrollRow = 8641
        ActiveWindow.ScrollRow = 8101
        ActiveWindow.ScrollRow = 7426
        ActiveWindow.ScrollRow = 6751
        ActiveWindow.ScrollRow = 6211
        ActiveWindow.ScrollRow = 5671
        ActiveWindow.ScrollRow = 5266
        ActiveWindow.ScrollRow = 4861
        ActiveWindow.ScrollRow = 4591
        ActiveWindow.ScrollRow = 4186
        ActiveWindow.ScrollRow = 3781
        ActiveWindow.ScrollRow = 3646
        ActiveWindow.ScrollRow = 3511
        ActiveWindow.ScrollRow = 3241
        ActiveWindow.ScrollRow = 2971
        ActiveWindow.ScrollRow = 2836
        ActiveWindow.ScrollRow = 2701
        ActiveWindow.ScrollRow = 2566
        ActiveWindow.ScrollRow = 2431
        ActiveWindow.ScrollRow = 2296
        ActiveWindow.ScrollRow = 2161
        ActiveWindow.ScrollRow = 2026
        ActiveWindow.ScrollRow = 1756
        ActiveWindow.ScrollRow = 1621
        ActiveWindow.ScrollRow = 1486
        ActiveWindow.ScrollRow = 1351
        ActiveWindow.ScrollRow = 1216
        ActiveWindow.ScrollRow = 1081
        ActiveWindow.ScrollRow = 946
        ActiveWindow.ScrollRow = 811
        ActiveWindow.ScrollRow = 676
        ActiveWindow.ScrollRow = 541
        ActiveWindow.ScrollRow = 406
        ActiveWindow.ScrollRow = 271
        ActiveWindow.ScrollRow = 136
        ActiveWindow.ScrollRow = 1
        Columns("E:E").Select
        Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
        Selection.Copy
        Columns("F:F").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
        Columns("C:C").Select
        Selection.Copy
        Columns("G:G").Select
        ActiveSheet.Paste
        Range("G1").Select
       
        'cette partie ci dessous peut poser probleme a certains fichier alors voir OK1'
             
         
         Range("A1:G68468").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Paste
       
       
        Sheets("Feuil3").Select
        Range("A1:D44285").Select
        Range("B6").Activate
        Application.CutCopyMode = False
        Selection.Copy
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Paste
        Columns("A:C").Select
        Range("C1").Activate
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlToLeft
        Sheets("Feuil2").Select
        Columns("F:F").Select
        Selection.Copy
        Sheets("Feuil4").Select
        Columns("B:B").Select
        ActiveSheet.Paste
        Rows("1:1").Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlUp
        Columns("A:B").Select
        Selection.Copy
        Sheets.Add After:=Sheets(Sheets.Count)
        Columns("A:B").Select
        Range("A1").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "Timed"
        Range("A3").Select
        ActiveCell.FormulaR1C1 = "D R "
        Range("A4").Select
        ActiveCell.FormulaR1C1 = _
            "VOC MIMIC CHARGE SUP POUR FRAPER ATRAPER MORDRE GENITAL MONTE "
        Range("A5").Select
        ActiveCell.FormulaR1C1 = "AFFI SG "
        Range("A6").Select
        ActiveCell.FormulaR1C1 = "ATAS DEF"
        Range("A7").Select
        ActiveCell.FormulaR1C1 = "BB"
        Range("A8").Select
        ActiveCell.FormulaR1C1 = "COPU"
        Range("A9").Select
        ActiveCell.FormulaR1C1 = "VOISIN"
        Range("A10").Select
        ActiveCell.FormulaR1C1 = _
            "FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40"
        Range("A11").Select
        ActiveCell.FormulaR1C1 = _
            "E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL"
        Range("A12").Select
        ActiveCell.FormulaR1C1 = " "
        Rows("10:10").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A14").Select
        ActiveCell.FormulaR1C1 = "Individuos Machos ("
        Range("A11").Select
        ActiveCell.FormulaR1C1 = _
            "FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40"
        Range("A14").Select
        ActiveCell.FormulaR1C1 = _
            "Individuos Machos (FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40)"
        Range("A15").Select
        ActiveCell.FormulaR1C1 = "Individuos Embras ("
        Range("A12").Select
        ActiveCell.FormulaR1C1 = _
            "E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL"
        Range("A15").Select
        ActiveCell.FormulaR1C1 = _
            "Individuos Embras (E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL)"
        Range("A16").Select
        ActiveCell.FormulaR1C1 = "DIA"
        Range("A17").Select
        ActiveCell.FormulaR1C1 = "HORA "
        Range("A18").Select
        ActiveCell.FormulaR1C1 = "SEXO"
       
    'Coller les colones A et B  de la feuille 4 sur la feuille 5 en dessous des déclaration des données'


        Sheets("Feuil4").Select
        Range("A1:B7710").Select
        Selection.Copy
        Sheets("Feuil5").Select
        Range("A23").Select
        ActiveSheet.Paste
       
        Dim l As Long
    For l = Sheets("Feuil5").Cells(65356, 2).End(xlUp).Row To 1 Step -1
    If Sheets("Feuil5").Cells(l, 2).Text = "#VALEUR!" Then Sheets("Feuil5").Cells(l, 2).ClearContents
    Next l

        Dim Lg&, A As Long
            Application.ScreenUpdating = False
            Lg = Range("b" & Rows.Count).End(xlUp).Row + 1

            With Sheets("Feuil5")
                For A = 23 To Lg
                    If .Cells(A, "b") = "" And .Cells(A, "a") <> "/" Then .Cells(A, "a") = "/"
                Next A
            End With
       
    End Sub


Voilà si quelqu'un peut m'aider à faire cela sa serais vraiment chouette, je vous remercie d'avance. Si de plus on peut m'indiquer ou coller et quoi modifier pour pouvoir inserer une toute autre macro à l'avenir se serais vraiment super.
 
Dernière édition:
Trier par date Trier par votes
Gorfael

Gorfael

XLDnaute Barbatruc
Re : Modification de macroS pour quelles puisses se "combiner"

Salut Sobas et le forum
À l'image de ton orthographe, ton code plus qu'approximatif :
quelques exemples :
Code: 
    Range("E2").Select
    Selection.Copy
    Range("M2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = " Obs0"
si je lis :
Range("E2").Select => sélectionner E2 : je comprends
Selection.Copy => copier la sélection
Range("M2").Select => sélectionner M2
ActiveSheet.Paste =>coller. Donc, on a copier le contenu de E2 sur M2
Application.CutCopyMode = False => ça sert à enlever les tirets clignotants. Pas utile ici, mais...
ActiveCell.FormulaR1C1 = " Obs0" => La cellule active, c'est M2. on remplace sa formule ??? mais on vient de lui coller un contenu ??? Il suffisait de faire
Range("M2").FormulaR1C1 = " Obs0" pour le même résultat, en plus court !
Code: 
ActiveWindow.ScrollRow = 30649
afficher la ligne 30649 => mais qu'est-ce qu'on en a à faire ? On est en VBA ! On n'a pas besoin de voir ce qu'il fait, juste qu'il le fasse !

Nettoye ton code, ou donne ce que doit faire ta/tes macros et on pourra vraisemblablement t'aider.
A
 
Vote positif 0 Vote négatif
S

Sobas

XLDnaute Nouveau
Re : Modification de macroS pour quelles puisses se "combiner"

Salut, désolé pour mon orthographe, je suis dyslexique... Pour mon code il s'agit d'une macro enregistré et vue que je ne connais rien en programmation....
En tout cas merci pour les infos, j'ai nettoyé mon code, sa ma d’ailleurs permis de comprendre pas mal de chose, donc vraiment merci, c super!!
Voici donc ma macro nettoyé:
PHP: 
Sub traduction_données_brutes()

' Touche de raccourci du clavier: Ctrl+q
'

'Titres des colonnes en ligne 1

    Columns("F:G").ClearContents
    Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").FormulaR1C1 = "DATE"
    Range("B1").FormulaR1C1 = "HEUR"
    Range("C1").FormulaR1C1 = "TEMPS ECOULE"
    Range("D1").FormulaR1C1 = "SUBJECT"
    Range("E1").FormulaR1C1 = "OBS"
    
   
    Cells.Select
    Range("G12").Activate
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    Range("F2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F30795"), Type:=xlFillDefault
     
    
     'liste des traduction des codes
       
       Range("L2").Select
    ActiveCell.FormulaR1C1 = " Subject0"
    Range("M2").FormulaR1C1 = " Obs0"
    Range("L2").Select
    Selection.AutoFill Destination:=Range("L2:L11"), Type:=xlFillDefault
    Range("L2:L11").Select
    Range("M2").Select
    Selection.AutoFill Destination:=Range("M2:M9"), Type:=xlFillDefault
    Range("M2:M9").Select
    Range("M2:M9").Copy Destination:=Range("M10")
    Range("M2:M9").Copy Destination:=Range("M18")
    Range("M2:M9").Copy Destination:=Range("M26")
    Range("M2:M9").Copy Destination:=Range("M34")
    Range("M2:M9").Copy Destination:=Range("M42")
    Range("M2:M9").Copy Destination:=Range("M50")
    Range("M2:M9").Copy Destination:=Range("M58")
    Range("M2:M9").Copy Destination:=Range("M66")
    Range("M2:M9").Copy Destination:=Range("M74")
    ActiveWindow.SmallScroll Down:=-80
    Range("L2:L11").Select
    Application.CutCopyMode = False
    
    Range("L2:L11").Copy Destination:=Range("L11")
    Range("L2:L9").FormulaR1C1 = " Subject0"
    Range("L10:L17").FormulaR1C1 = " Subject1"
    Range("L18:L25").FormulaR1C1 = " Subject2"
    Range("L26:L33").FormulaR1C1 = " Subject3"
    Range("L34:L41").FormulaR1C1 = " Subject4"
    Range("L42:L49").FormulaR1C1 = " Subject5"
    Range("L50:L57").FormulaR1C1 = " Subject6"
    Range("L58:L65").FormulaR1C1 = " Subject7"
    Range("L66:L73").FormulaR1C1 = " Subject8"
    Range("L74:L81").FormulaR1C1 = " Subject9"
    
    
    
    Range("L74:L81").Select
    
    ActiveWindow.SmallScroll Down:=-95
    Range("N2").FormulaR1C1 = "D"
    Range("N3").FormulaR1C1 = "R"
    Range("N4").FormulaR1C1 = "AFFI"
    Range("N5").FormulaR1C1 = "CLINEX"
    Range("N6").FormulaR1C1 = "MONO"
    Range("N7").FormulaR1C1 = "M20"
    Range("N8").FormulaR1C1 = "274"
    Range("N9").FormulaR1C1 = "360"
    Range("N10").FormulaR1C1 = "ET"
    Range("N11").FormulaR1C1 = "MORDRE"
    Range("N12").FormulaR1C1 = "SG"
    Range("N13").FormulaR1C1 = "KO"
    Range("N14").FormulaR1C1 = "G403"
    Range("N15").FormulaR1C1 = "NEZ"
    Range("N16").FormulaR1C1 = "277"
    Range("N17").FormulaR1C1 = "PUNK"
    Range("N18").FormulaR1C1 = "FO"
    Range("N19").FormulaR1C1 = "PRESENT"
    Range("N20").FormulaR1C1 = "DEF"
    Range("N21").FormulaR1C1 = "ZORO"
    Range("N22").FormulaR1C1 = "LIPS"
    Range("N23").FormulaR1C1 = "P40"
    Range("N24").FormulaR1C1 = "EPIS"
    Range("N25").FormulaR1C1 = "G400"
    Range("N26").FormulaR1C1 = "VOC"
    Range("N27").FormulaR1C1 = "GENITAL"
    Range("N28").FormulaR1C1 = "BB"
    Range("N29").FormulaR1C1 = "2F"
    Range("N30").FormulaR1C1 = "BOITE"
    Range("N31").FormulaR1C1 = "E66"
    Range("N32").FormulaR1C1 = "ZORO"
    Range("N33").FormulaR1C1 = "MARILIN"
    Range("N34").FormulaR1C1 = "MIMIC"
    Range("N35").FormulaR1C1 = "MONTE"
    Range("N36").FormulaR1C1 = "COPU"
    Range("N37").FormulaR1C1 = "COJAK"
    Range("N38").FormulaR1C1 = "ARTHUR"
    Range("N39").FormulaR1C1 = "160"
    Range("N40").FormulaR1C1 = "A330"
    Range("N41").FormulaR1C1 = "K431"
    Range("N42").FormulaR1C1 = "CHARGE"
    Range("N43").FormulaR1C1 = "ATAQ"
    Range("N44").FormulaR1C1 = "VOISIN"
    Range("N45").FormulaR1C1 = "ALPHA"
    Range("N46").FormulaR1C1 = "VIN"
    Range("N47").FormulaR1C1 = "2L"
    Range("N48").FormulaR1C1 = "NEIG"
    Range("N49").FormulaR1C1 = "L11"
    Range("N50").FormulaR1C1 = "SUP"
    Range("N51").FormulaR1C1 = "ALOG"
    Range("N52").FormulaR1C1 = "FLIP"
    Range("N53").FormulaR1C1 = "MERT"
    Range("N54").FormulaR1C1 = "BOITE"
    Range("N55").FormulaR1C1 = "NARINE"
    Range("N56").FormulaR1C1 = "MARILIN"
    Range("N57").FormulaR1C1 = "M21"
    Range("N58").FormulaR1C1 = "POUR"
    Range("N59").FormulaR1C1 = "JOUER"
    Range("N60").FormulaR1C1 = "ALDO"
    Range("N61").FormulaR1C1 = "DIGIT"
    Range("N62").FormulaR1C1 = "PELE"
    Range("N63").FormulaR1C1 = "203"
    Range("N64").FormulaR1C1 = "ALPHAF"
    Range("N65").FormulaR1C1 = "O30"
    Range("N66").FormulaR1C1 = "FRAPER"
    Range("N67").FormulaR1C1 = "REPOC"
    Range("N68").FormulaR1C1 = "FK"
    Range("N69").FormulaR1C1 = "QAZI"
    Range("N70").FormulaR1C1 = "L10"
    Range("N71").FormulaR1C1 = "PP"
    Range("N72").FormulaR1C1 = "DIANA"
    Range("N73").FormulaR1C1 = "FOFOL"
    Range("N74").FormulaR1C1 = "ATRAPER"
    Range("N75").FormulaR1C1 = "TRYADE"
    Range("N76").FormulaR1C1 = "REMS"
    Range("N77").FormulaR1C1 = "FRER"
    Range("N78").FormulaR1C1 = "AL"
    Range("N79").FormulaR1C1 = "PIRAT"
    Range("N80").FormulaR1C1 = "2T"
    Range("N81").FormulaR1C1 = "STOP"
     
'Mise en forme dans une seconde feuille
    
    Range("L2:M81").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-20
    Range("K2").Select
    ActiveSheet.Paste
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]"
    Range("M2").Select
    Selection.AutoFill Destination:=Range("M2:M81"), Type:=xlFillDefault
    Range("M2:M81").Select
    ActiveWindow.SmallScroll Down:=-95
    Range("G2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISNA(VLOOKUP(RC[-3]&RC[-2],R2C12:R81C14,2,FALSE)),"""",VLOOKUP(RC[-3]&RC[-2],R2C12:R81C14,2,FALSE))"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISNA(VLOOKUP(RC[-3]&RC[-2],R2C13:R81C14,2,FALSE)),"""",VLOOKUP(RC[-3]&RC[-2],R2C13:R81C14,2,FALSE))"
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G44285"), Type:=xlFillDefault
    Range("G2").Select
    ActiveWindow.SmallScroll Down:=-30
    ActiveWindow.ScrollRow = 1


    Range("A1:G155").Select

    ActiveWindow.ScrollRow = 1
    Columns("A:G").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("D:F").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("H5").Select
    Sheets("Feuil1").Select
    Columns("A:A").Select
    Selection.Copy
    Sheets("Feuil2").Select
    Columns("A:A").Select
    ActiveSheet.Paste
    Range("F8").Select



    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=TIMEVALUE(RC[-3])-TEMPSVAL5"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=TIMEVALUE(RC[-3])-TIMEVALUE(R2C[-3])"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E20000"), Type:=xlFillDefault
    Range("E2").Select

    ActiveWindow.ScrollRow = 1
    Columns("E:E").Select
    Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
    Selection.Copy
    Columns("F:F").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"

       Columns("A:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
     Columns("B").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    
   'je ne sais pas pourquoi je dois obligatoirement choisir une ligne et non juste la colonne!!
   'se qui me fait ralentire concidérablement ma macro à l'exécution!
   's'il est possible de modifier ça sa serais super
   
   Dim I As Long
For I = Sheets("Feuil2").Cells(99999, 2).End(xlUp).Row To 1 Step -1
If Sheets("Feuil2").Cells(I, 2).Text = "#VALEUR!" Then Sheets("Feuil2").Cells(I, 2).ClearContents
Next I

    Sheets.Add After:=Sheets(Sheets.Count)
    Columns("A:B").Select
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Timed"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "D R "
    Range("A4").Select
    ActiveCell.FormulaR1C1 = _
        "VOC MIMIC CHARGE SUP POUR FRAPER ATRAPER MORDRE GENITAL MONTE "
    Range("A5").FormulaR1C1 = "AFFI SG "
    Range("A6").FormulaR1C1 = "ATAS DEF"
    Range("A7").FormulaR1C1 = "BB"
    Range("A8").FormulaR1C1 = "COPU"
    Range("A9").FormulaR1C1 = "VOISIN"
    Range("A10").FormulaR1C1 = _
        "FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40"
    Range("A11").FormulaR1C1 = _
        "E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL"
    Range("A12").FormulaR1C1 = " "
    Rows("10:10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A14").FormulaR1C1 = "Individuos Machos ("
    Range("A11").FormulaR1C1 = _
        "FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40"
    Range("A14").FormulaR1C1 = _
        "Individuos Machos (FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40)"
    Range("A15").FormulaR1C1 = "Individuos Embras ("
    Range("A12").FormulaR1C1 = _
        "E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL"
    Range("A15").FormulaR1C1 = _
        "Individuos Embras (E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL)"
    Range("A16").FormulaR1C1 = "DIA"
    Range("A17").FormulaR1C1 = "HORA "
    Range("A18").FormulaR1C1 = "SEXO"
    


    Sheets("Feuil2").Select
    Range("A1:B20000").Select
    Selection.Copy
    Sheets("Feuil3").Select
    Range("A23").Select
    ActiveSheet.Paste
    


    Dim Lg&, A As Long
        Application.ScreenUpdating = False
        Lg = Range("b" & Rows.Count).End(xlUp).Row + 1

        With Sheets("Feuil3")
            For A = 24 To Lg
                If .Cells(A, "b") = "" And .Cells(A, "a") <> "/" Then .Cells(A, "a") = "/"
            Next A
        End With
        
   Sheets("Feuil2").Select
   


        Columns("A:A").Select
    Selection.Cut
    Columns("C:C").Select
    ActiveSheet.Paste
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
End Sub

J'espère que c'est suffisamment nettoyé, en tout cas s'il y a quoi que se soit d'autre a faire, je suis bien sur près à le faire, surtout si comme précédemment, sa me permet de comprendre quelques règles syntaxique.
Merci a toi Gorfael.
 
Dernière édition:
Vote positif 0 Vote négatif
S

Sobas

XLDnaute Nouveau
Re : Modification de macroS pour quelles puisses se "combiner"

Bon alors, j'ai réussis à "fusionner les deux macro pour réaliser en boucle le traitement. Pour cela j'ai changé là où il y avait xls par xlsx puis changé le nom de la macro à appeler par le mien. Mais le problème est que je n'obtient pas du tout le même résultat qu'avec ma macro effectué sur un seul dossier. De plus la boucle qui est sensé traité tout les fichier n'en traite que un seul.
Voici les deux macro fusionné:

Code: 
Public Chemin, Fich As String, ReponseMsgBox As Variant

'                                           .
'routine d'appel depuis le bouton sur feuille
'                                           .
Public Sub SelectionnerRepertoire()
Chemin = FLoadNomDuREP: Chemin = Trim(Chemin): If Chemin = "" Then Exit Sub
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
DoEvents
'demande de confirmation
M$ = "Traiter tous les Fichiers xlsx du répertoire suivant :" & vbLf & Chemin & vbLf & vbLf & "Veuillez confirmer ?"
ReponseMsgBox = MsgBox(M$, vbQuestion + vbYesNo, "Traitement des fichiers")
If ReponseMsgBox = vbYes Then
   BoucleDeTraitement ' appel la routine de traitement des fichiers
   MsgBox "Traitement terminé !", vbInformation
Else
   MsgBox "Traitement abandonné !", vbExclamation
End If
End Sub

' , &H1&)=avec bouton "créer un nouveau dossier" ... , $H201&)=sans le bouton
'objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&, RepDefaut)
Private Function FLoadNomDuREP() As String
Dim objShell As Object, objFolder As Object, REP As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&)
If Not objFolder Is Nothing Then
   REP = objFolder.Items.Item.Path
   If Right(REP, 1) <> "\" Then REP = REP & "\"
End If
FLoadNomDuREP = REP
Set objShell = Nothing: Set objFolder = Nothing
End Function

'                                                                               .
'                                                                               .

Private Sub BoucleDeTraitement() ' la boucle de traitement des fichiers
Application.ScreenUpdating = False
ChDir Chemin
Fich = Dir(Chemin & "*.xlsx")
Do While Fich <> ""
  Workbooks.Open Chemin & Fich
  traduction_données_brutes
  ActiveWorkbook.Close True
  Fich = Dir
Loop
Application.ScreenUpdating = True
End Sub


Sub traduction_données_brutes()

' Touche de raccourci du clavier: Ctrl+q
'

'Titres des colonnes en ligne 1

    Columns("F:G").ClearContents
    Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").FormulaR1C1 = "DATE"
    Range("B1").FormulaR1C1 = "HEUR"
    Range("C1").FormulaR1C1 = "TEMPS ECOULE"
    Range("D1").FormulaR1C1 = "SUBJECT"
    Range("E1").FormulaR1C1 = "OBS"
    
   
    Cells.Select
    Range("G12").Activate
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    Range("F2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F30795"), Type:=xlFillDefault
     
    
     'liste des traduction des codes
       
       Range("L2").Select
    ActiveCell.FormulaR1C1 = " Subject0"
    Range("M2").FormulaR1C1 = " Obs0"
    Range("L2").Select
    Selection.AutoFill Destination:=Range("L2:L11"), Type:=xlFillDefault
    Range("L2:L11").Select
    Range("M2").Select
    Selection.AutoFill Destination:=Range("M2:M9"), Type:=xlFillDefault
    Range("M2:M9").Select
    Range("M2:M9").Copy Destination:=Range("M10")
    Range("M2:M9").Copy Destination:=Range("M18")
    Range("M2:M9").Copy Destination:=Range("M26")
    Range("M2:M9").Copy Destination:=Range("M34")
    Range("M2:M9").Copy Destination:=Range("M42")
    Range("M2:M9").Copy Destination:=Range("M50")
    Range("M2:M9").Copy Destination:=Range("M58")
    Range("M2:M9").Copy Destination:=Range("M66")
    Range("M2:M9").Copy Destination:=Range("M74")
    ActiveWindow.SmallScroll Down:=-80
    Range("L2:L11").Select
    Application.CutCopyMode = False
    
    Range("L2:L11").Copy Destination:=Range("L11")
    Range("L2:L9").FormulaR1C1 = " Subject0"
    Range("L10:L17").FormulaR1C1 = " Subject1"
    Range("L18:L25").FormulaR1C1 = " Subject2"
    Range("L26:L33").FormulaR1C1 = " Subject3"
    Range("L34:L41").FormulaR1C1 = " Subject4"
    Range("L42:L49").FormulaR1C1 = " Subject5"
    Range("L50:L57").FormulaR1C1 = " Subject6"
    Range("L58:L65").FormulaR1C1 = " Subject7"
    Range("L66:L73").FormulaR1C1 = " Subject8"
    Range("L74:L81").FormulaR1C1 = " Subject9"
    
    
    
    Range("L74:L81").Select
    
    ActiveWindow.SmallScroll Down:=-95
    Range("N2").FormulaR1C1 = "D"
    Range("N3").FormulaR1C1 = "R"
    Range("N4").FormulaR1C1 = "AFFI"
    Range("N5").FormulaR1C1 = "CLINEX"
    Range("N6").FormulaR1C1 = "MONO"
    Range("N7").FormulaR1C1 = "M20"
    Range("N8").FormulaR1C1 = "274"
    Range("N9").FormulaR1C1 = "360"
    Range("N10").FormulaR1C1 = "ET"
    Range("N11").FormulaR1C1 = "MORDRE"
    Range("N12").FormulaR1C1 = "SG"
    Range("N13").FormulaR1C1 = "KO"
    Range("N14").FormulaR1C1 = "G403"
    Range("N15").FormulaR1C1 = "NEZ"
    Range("N16").FormulaR1C1 = "277"
    Range("N17").FormulaR1C1 = "PUNK"
    Range("N18").FormulaR1C1 = "FO"
    Range("N19").FormulaR1C1 = "PRESENT"
    Range("N20").FormulaR1C1 = "DEF"
    Range("N21").FormulaR1C1 = "ZORO"
    Range("N22").FormulaR1C1 = "LIPS"
    Range("N23").FormulaR1C1 = "P40"
    Range("N24").FormulaR1C1 = "EPIS"
    Range("N25").FormulaR1C1 = "G400"
    Range("N26").FormulaR1C1 = "VOC"
    Range("N27").FormulaR1C1 = "GENITAL"
    Range("N28").FormulaR1C1 = "BB"
    Range("N29").FormulaR1C1 = "2F"
    Range("N30").FormulaR1C1 = "BOITE"
    Range("N31").FormulaR1C1 = "E66"
    Range("N32").FormulaR1C1 = "ZORO"
    Range("N33").FormulaR1C1 = "MARILIN"
    Range("N34").FormulaR1C1 = "MIMIC"
    Range("N35").FormulaR1C1 = "MONTE"
    Range("N36").FormulaR1C1 = "COPU"
    Range("N37").FormulaR1C1 = "COJAK"
    Range("N38").FormulaR1C1 = "ARTHUR"
    Range("N39").FormulaR1C1 = "160"
    Range("N40").FormulaR1C1 = "A330"
    Range("N41").FormulaR1C1 = "K431"
    Range("N42").FormulaR1C1 = "CHARGE"
    Range("N43").FormulaR1C1 = "ATAQ"
    Range("N44").FormulaR1C1 = "VOISIN"
    Range("N45").FormulaR1C1 = "ALPHA"
    Range("N46").FormulaR1C1 = "VIN"
    Range("N47").FormulaR1C1 = "2L"
    Range("N48").FormulaR1C1 = "NEIG"
    Range("N49").FormulaR1C1 = "L11"
    Range("N50").FormulaR1C1 = "SUP"
    Range("N51").FormulaR1C1 = "ALOG"
    Range("N52").FormulaR1C1 = "FLIP"
    Range("N53").FormulaR1C1 = "MERT"
    Range("N54").FormulaR1C1 = "BOITE"
    Range("N55").FormulaR1C1 = "NARINE"
    Range("N56").FormulaR1C1 = "MARILIN"
    Range("N57").FormulaR1C1 = "M21"
    Range("N58").FormulaR1C1 = "POUR"
    Range("N59").FormulaR1C1 = "JOUER"
    Range("N60").FormulaR1C1 = "ALDO"
    Range("N61").FormulaR1C1 = "DIGIT"
    Range("N62").FormulaR1C1 = "PELE"
    Range("N63").FormulaR1C1 = "203"
    Range("N64").FormulaR1C1 = "ALPHAF"
    Range("N65").FormulaR1C1 = "O30"
    Range("N66").FormulaR1C1 = "FRAPER"
    Range("N67").FormulaR1C1 = "REPOC"
    Range("N68").FormulaR1C1 = "FK"
    Range("N69").FormulaR1C1 = "QAZI"
    Range("N70").FormulaR1C1 = "L10"
    Range("N71").FormulaR1C1 = "PP"
    Range("N72").FormulaR1C1 = "DIANA"
    Range("N73").FormulaR1C1 = "FOFOL"
    Range("N74").FormulaR1C1 = "ATRAPER"
    Range("N75").FormulaR1C1 = "TRYADE"
    Range("N76").FormulaR1C1 = "REMS"
    Range("N77").FormulaR1C1 = "FRER"
    Range("N78").FormulaR1C1 = "AL"
    Range("N79").FormulaR1C1 = "PIRAT"
    Range("N80").FormulaR1C1 = "2T"
    Range("N81").FormulaR1C1 = "STOP"
     
'Mise en forme dans une seconde feuille
    
    Range("L2:M81").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-20
    Range("K2").Select
    ActiveSheet.Paste
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]"
    Range("M2").Select
    Selection.AutoFill Destination:=Range("M2:M81"), Type:=xlFillDefault
    Range("M2:M81").Select
    ActiveWindow.SmallScroll Down:=-95
    Range("G2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISNA(VLOOKUP(RC[-3]&RC[-2],R2C12:R81C14,2,FALSE)),"""",VLOOKUP(RC[-3]&RC[-2],R2C12:R81C14,2,FALSE))"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISNA(VLOOKUP(RC[-3]&RC[-2],R2C13:R81C14,2,FALSE)),"""",VLOOKUP(RC[-3]&RC[-2],R2C13:R81C14,2,FALSE))"
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G44285"), Type:=xlFillDefault
    Range("G2").Select
    ActiveWindow.SmallScroll Down:=-30
    ActiveWindow.ScrollRow = 1


    Range("A1:G155").Select

    ActiveWindow.ScrollRow = 1
    Columns("A:G").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("D:F").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("H5").Select
    Sheets("Feuil1").Select
    Columns("A:A").Select
    Selection.Copy
    Sheets("Feuil2").Select
    Columns("A:A").Select
    ActiveSheet.Paste
    Range("F8").Select



    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=TIMEVALUE(RC[-3])-TEMPSVAL5"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=TIMEVALUE(RC[-3])-TIMEVALUE(R2C[-3])"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E20000"), Type:=xlFillDefault
    Range("E2").Select

    ActiveWindow.ScrollRow = 1
    Columns("E:E").Select
    Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
    Selection.Copy
    Columns("F:F").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"

       Columns("A:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
     Columns("B").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    
   'je ne sais pas pourquoi je dois obligatoirement choisir une ligne et non juste la colonne!!
   'se qui me fait ralentire concidérablement ma macro à l'exécution!
   's'il est possible de modifier ça sa serais super
   
   Dim I As Long
For I = Sheets("Feuil2").Cells(99999, 2).End(xlUp).Row To 1 Step -1
If Sheets("Feuil2").Cells(I, 2).Text = "#VALEUR!" Then Sheets("Feuil2").Cells(I, 2).ClearContents
Next I

    Sheets.Add After:=Sheets(Sheets.Count)
    Columns("A:B").Select
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Timed"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "D R "
    Range("A4").Select
    ActiveCell.FormulaR1C1 = _
        "VOC MIMIC CHARGE SUP POUR FRAPER ATRAPER MORDRE GENITAL MONTE "
    Range("A5").FormulaR1C1 = "AFFI SG "
    Range("A6").FormulaR1C1 = "ATAS DEF"
    Range("A7").FormulaR1C1 = "BB"
    Range("A8").FormulaR1C1 = "COPU"
    Range("A9").FormulaR1C1 = "VOISIN"
    Range("A10").FormulaR1C1 = _
        "FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40"
    Range("A11").FormulaR1C1 = _
        "E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL"
    Range("A12").FormulaR1C1 = " "
    Rows("10:10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A14").FormulaR1C1 = "Individuos Machos ("
    Range("A11").FormulaR1C1 = _
        "FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40"
    Range("A14").FormulaR1C1 = _
        "Individuos Machos (FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40)"
    Range("A15").FormulaR1C1 = "Individuos Embras ("
    Range("A12").FormulaR1C1 = _
        "E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL"
    Range("A15").FormulaR1C1 = _
        "Individuos Embras (E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL)"
    Range("A16").FormulaR1C1 = "DIA"
    Range("A17").FormulaR1C1 = "HORA "
    Range("A18").FormulaR1C1 = "SEXO"
    


    Sheets("Feuil2").Select
    Range("A1:B20000").Select
    Selection.Copy
    Sheets("Feuil3").Select
    Range("A23").Select
    ActiveSheet.Paste
    


    Dim Lg&, A As Long
        Application.ScreenUpdating = False
        Lg = Range("b" & Rows.Count).End(xlUp).Row + 1

        With Sheets("Feuil3")
            For A = 24 To Lg
                If .Cells(A, "b") = "" And .Cells(A, "a") <> "/" Then .Cells(A, "a") = "/"
            Next A
        End With
        
   Sheets("Feuil2").Select
   


        Columns("A:A").Select
    Selection.Cut
    Columns("C:C").Select
    ActiveSheet.Paste
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
End Sub

si vous comparé le résultat avec ma macro vous verrez l'énorme différence (c'est comme s'il effectué deux fois la macro en oubliant une partie).
Voilà si quelqu'un peut m'aider.
Merci
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
2 K
fanou06
F
L
  • Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
610
fanfan38
fanfan38
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
B
  • Résolu(e)
XL 2016 macro avec boucle
2
Réponses
16
Affichages
1 K
benbella1991
B
K
  • Résolu(e)
Microsoft 365 Ouvrir un autre classeur excel (VBA) pour utiliser les données de celui dans le classeur actif
Réponses
5
Affichages
850
Dranreb
Dranreb
A
  • Résolu(e)
XL 2016 Autofill Destination sur colonne adjacente
Réponses
3
Affichages
356
Aldonanou
A
J
  • Question
Microsoft 365 Formules
Réponses
2
Affichages
436
jper
J
lestoiles1
  • Question
XL 2013 Fonction vba copie coller
Réponses
1
Affichages
843
job75
job75
B
  • Question
Microsoft 365 Colorer les Lignes coller
Réponses
4
Affichages
613
bd.afaf
B
J
  • Question
XL 2019 Borné une extraction par date
2
Réponses
22
Affichages
2 K
jui42
J

Membres actuellement en ligne

13 membres et 251 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 299
Messages
2 086 986
Membres
103 419
dernier inscrit
mk29