bonjour
suite à un fichier .bas trouve sur le site de fred sigonneau, j'ai adapte le code à mon projet mais un proble subsiste.
suite a la mise en place d'une macro pour recuperer des donnees dans
un classeur fermé, tout fonctionne pour le texte mais pour les dates
recuperees ca bug, cela ne m'ecrit pas la date telle qu'elle est dans
mon classeur fermé
voici le fichier joint
Cijoint.fr - Service gratuit de dépôt de fichiers
et le code
voici le code que j'ai pour recuperer mes donnees
Sub LoopThruFiles()
Application.EnableEvents = False
Dim place As String
Dim FilesArray() As String, FileCounter As Integer
Dim FName As String, LoopCounter As Integer
FName = Dir(ThisWorkbook.Path & "\LISTE\*.xls")
Do While Len(FName) > 0
FileCounter = FileCounter + 1
ReDim Preserve FilesArray(1 To FileCounter)
FilesArray(FileCounter) = FName
FName = Dir()
Loop
If FileCounter > 0 Then
Application.ScreenUpdating = False
For LoopCounter = 1 To FileCounter
x = LoopCounter
'calcul de la plage de destination
place = Range(Cells((((x - 1) * 99) + 2), 1), Cells(((x *
99)), 7)).Address
'METTRE LA LETTRE DU DISQUE DUR CONCERNE C,D, E,ETC...
GetValues "E:", FilesArray(LoopCounter), "Blad1",
"a1:G100", place
Next
Application.ScreenUpdating = True
End If
Columns("A:G").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
Application.EnableEvents = True
End Sub
Sub GetValues(fPath As String, FName As String, sName, _
cellRange As String, place As String)
'recopie une plage des valeurs externes dans une plage de
'la feuille active sous forme d'une formule matricielle
With ActiveSheet.Range(place)
.FormulaArray = "='" & ThisWorkbook.Path & "\LISTE" & "\[" &
FName & "]" & sName & "'!" & cellRange
.Value = .Value
Range(place).Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart,
_
SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
End With
End Sub
suite à un fichier .bas trouve sur le site de fred sigonneau, j'ai adapte le code à mon projet mais un proble subsiste.
suite a la mise en place d'une macro pour recuperer des donnees dans
un classeur fermé, tout fonctionne pour le texte mais pour les dates
recuperees ca bug, cela ne m'ecrit pas la date telle qu'elle est dans
mon classeur fermé
voici le fichier joint
Cijoint.fr - Service gratuit de dépôt de fichiers
et le code
voici le code que j'ai pour recuperer mes donnees
Sub LoopThruFiles()
Application.EnableEvents = False
Dim place As String
Dim FilesArray() As String, FileCounter As Integer
Dim FName As String, LoopCounter As Integer
FName = Dir(ThisWorkbook.Path & "\LISTE\*.xls")
Do While Len(FName) > 0
FileCounter = FileCounter + 1
ReDim Preserve FilesArray(1 To FileCounter)
FilesArray(FileCounter) = FName
FName = Dir()
Loop
If FileCounter > 0 Then
Application.ScreenUpdating = False
For LoopCounter = 1 To FileCounter
x = LoopCounter
'calcul de la plage de destination
place = Range(Cells((((x - 1) * 99) + 2), 1), Cells(((x *
99)), 7)).Address
'METTRE LA LETTRE DU DISQUE DUR CONCERNE C,D, E,ETC...
GetValues "E:", FilesArray(LoopCounter), "Blad1",
"a1:G100", place
Next
Application.ScreenUpdating = True
End If
Columns("A:G").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
Application.EnableEvents = True
End Sub
Sub GetValues(fPath As String, FName As String, sName, _
cellRange As String, place As String)
'recopie une plage des valeurs externes dans une plage de
'la feuille active sous forme d'une formule matricielle
With ActiveSheet.Range(place)
.FormulaArray = "='" & ThisWorkbook.Path & "\LISTE" & "\[" &
FName & "]" & sName & "'!" & cellRange
.Value = .Value
Range(place).Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart,
_
SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
End With
End Sub