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:
Et voici ma macro:
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.
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: