Bonsoir ;
Résolu ou pas, ma question est bête, voici un programme qui permet de sélectionner 1 ou +sieurs fichier(s) dans n'importe quel(s) répertoire(s) d'un disque local ou réseau. Les fichiers excel doivent avoir la même structure et comporter la première ligne en commentaire sur chaque fichier excel(sinon, adapter la suppressionde ces lignes).
Ce VB concatène chacun des fichiers excel sélectionnés jusqu'à l'abandon et effectue une destruction de cellules non utiles puis constitue un fichier croisé dynamique en automatique. Il demande peut-être aussi une variable, je ne sais plus.
Bonne analyse. Supprimer les lignes inutiles. Si besoin, je peux envoyer le fichier excel en exemple.
--------------------------------VBA------------------------------------------------------------:
'La variable est de type Variant car elle peut prendre les valeurs:
'Booleenne: (Vrai/Faux) quand l'utilisateur ne sélectionne rien, ou annule l'opération.
'String: pour renvoyer le nom du fichier sélectionné.
Dim file As Variant
Dim fileTemplate As Variant
Dim WorkBookData As Workbook
Dim nbFichiers As Variant
Dim L1 As Variant
Dim LData As Variant
Dim CL As Range
Dim Navire As Variant
Dim Nbl As Integer
Dim Nbf As Integer
Dim f As Integer
Dim nom As String
Private Sub RazMiseEnFormeDatas()
Sheets("Feuil1").Activate
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlToRight).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
Selection.ClearComments
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlNone
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlNone
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlNone
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlNone
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlNone
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlNone
End With
Selection.Rows.AutoFit
Selection.Columns.AutoFit
End Sub
Private Sub SelectionFichierSimple()
'Affiche la boîte de dialogue "Ouvrir"
file = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
Nbf = WorksheetFunction.CountA(Columns("a:a"))
nom = file
MsgBox ("nom " & Nbf)
End Sub
Private Sub CopieDatasToTemplate()
' Ouverture du fichier de donnees
Workbooks.Open file
Set WorkBookData = Application.Workbooks.Open(file)
WorkBookData.Sheets(1).Select
Range("A1").Select
' MsgBox ("nombre lignes " & nom)
NbData = 0
NbData = WorksheetFunction.CountA(Columns("a:a"))
Range("A1:O" & NbData).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy
Windows(fileTemplate).Activate
Range("" & L1).Select
ActiveSheet.Paste
Range("" & L1).Select
fichier:
If f < Nbf Then
f = f + 1
Range("S" & f) = nom
GoTo fichier
End If
Application.CutCopyMode = False
WorkBookData.Close
End Sub
Sub Croise()
'
' tyty Macro
' Macro enregistrée le 07/11/2008
'
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Feuil1!R1C1:R" & Nbl & "C4").CreatePivotTable TableDestination:="", TableName:= _
"Tableau croisé dynamique4", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveWorkbook.ShowPivotTableFieldList = True
ActiveSheet.PivotTables("Tableau croisé dynamique4").AddFields RowFields:= _
Array("Stade_Montage", "Référence"), ColumnFields:=Array("Bloc", "Panneau")
ActiveSheet.PivotTables("Tableau croisé dynamique4").PivotFields("Référence"). _
Orientation = xlDataField
End Sub
Sub ImportData()
Nb = 0
Line = 1
f = 1
fileTemplate = ThisWorkbook.name
RazMiseEnFormeDatas
suite:
Nf = Nf + 1
SelectionFichierSimple
If file = "Faux" Then
Nbl = WorksheetFunction.CountA(Columns("a:a"))
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Columns("E:O").Select
Selection.Delete Shift:=xlToLeft
' Sheets("Feuil1").Activate
Recommence:
Line = Line + 1
Col = Range("A" & Line)
If Col = "Panneau" Then
Rows(Line).Delete
End If
If Line < Nbl Then
GoTo Recommence
Else
Nbl = WorksheetFunction.CountA(Columns("a:a"))
Navire = InputBox("Code du navire")
Line = 1
Range("E1") = "Navire"
nav:
If Line < Nbl Then
Line = Line + 1
Range("E" & Line) = Navire
GoTo nav
End If
Range("A1:G" & Nbl).Select
Set mafeuille = ActiveWorkbook.ActiveSheet
mafeuille.Copy
ActiveWorkbook.SaveAs Filename:=mafeuille.name, FileFormat:=xlText, CreateBackup:=False
mafeuille.Activate
transf
End If
Else
Nb = WorksheetFunction.CountA(Columns("a:a"))
Nb = Nb + 1
If Nb = 3 Then
Nb = 1
End If
L1 = ("A" & Nb)
'MsgBox ("L1 " & L1)
CopieDatasToTemplate
GoTo suite
End If
End Sub
