Sub ConvertirFichiersEnFeuilles()
Const Chemin = "[COLOR="Red"]Réperoire[/COLOR]"
Dim VarListeFichiers As Variant, VarFichier As Variant, WkClasseur As Workbook, WkFinal As Workbook
VarListeFichiers = Array("[COLOR="red"]Nom des fichiers.xlsx[/COLOR]", "[COLOR="red"]Nom des fichiers.xlsx[/COLOR]")
Set WkFinal = Workbooks.Add
For Each VarFichier In VarListeFichiers
WkFinal.Sheets.Add Type:=Chemin & VarFichier
Next
Consolidationpourimportation
Exit Sub
End Sub
Sub Consolidationpourimportation()
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
'--Suppression des messages d'alerte
Application.DisplayAlerts = False
'--Suppression des feuilles inutiles suite à l'importation
Sheets("Feuil2").Delete
Sheets("Feuil3").Delete
'--Copié/collé des données sur la Feuil1
For Ctr = 1 To Sheets.Count - 1
Sheets("feuil1").Activate
Col = "a"
NumLig = 0
With Sheets(Ctr)
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 2 To NbrLig
If .Cells(Lig, Col).Value <> "" Then
.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Sheets("feuil1").Cells(NumLig, 1).Insert Shift:=xlDown
End If
Next
End With
Next Ctr
'--Nommer "feuil1" et mise en place des noms des colonnes
ActiveSheet.Name = "importation"
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Date / Heure"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Numéro de téléphone et/ou nom & Prénom"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Activité"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Ligne"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Logiciel"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Probléme rencontré"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Status"
'--Suppression des onglets sauf celui qui est actif
For Ctr = Sheets.Count To 1 Step -1
If Sheets(Ctr).Name <> ActiveSheet.Name Then
Sheets(Ctr).Delete
End If
Next
'--Mise en page
Cells.Select
Selection.Columns.AutoFit
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
orderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub