Bonjour à tous
J'ai fait une macro pour récuperer des données de differents fichiers excel qu'il inscrit dans des colonnes successive.
mon soucis est qu'une fois 256 colonnes remplis ca bloque et pourtant je suis sur excel 2010
J'ai au moin 500 fichiers a traiter
merci pour votre aide
ma macro :
Sub Import()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim Colonne As Byte
'ouverture de la fenêtre de choix du répertoire
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
'Si l'utilisateur annule sans choisir
If objFolder Is Nothing Then
'message
MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else 'sinon
'Chemin = répertoire choisi
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
'Choix du 1er fichier
fichier = Dir(Chemin & "*.xls*")
'Colonne = n° de colonne ou on va coller les données
'pour commencer colonne A, laisser à 0, pour commencer colonne B remplacer 0 par 1 etc...
Colonne = 3
'on boucle sur tous les fichiers excel du répertoire choisi
Application.ScreenUpdating = False
Do While Len(fichier) > 0
Colonne = Colonne + 1
If fichier <> ThisWorkbook.Name Then
'attribue un nom dans le classeur, se référant à la plage à importer : B2:I18
ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]Etude'!$B$2:$m$20"
With Sheets("recup")
' "Importe les données" grâce au nom donné ci-dessus
.[B2:M20] = "=Plage"
'.[C3:C6].Copy 'Copie C3:C6'.[B3:B10].Copy 'Copie B3:B10
.[C3].Copy 'Copie C3'.[C3].Copy 'Copie C3
End With
With Sheets("ecris")
.Cells(1, Colonne).PasteSpecial xlPasteValues 'Colle c3
End With.....
End If
fichier = Dir()
Loop
End If
End Sub
J'ai fait une macro pour récuperer des données de differents fichiers excel qu'il inscrit dans des colonnes successive.
mon soucis est qu'une fois 256 colonnes remplis ca bloque et pourtant je suis sur excel 2010
J'ai au moin 500 fichiers a traiter
merci pour votre aide
ma macro :
Sub Import()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim Colonne As Byte
'ouverture de la fenêtre de choix du répertoire
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
'Si l'utilisateur annule sans choisir
If objFolder Is Nothing Then
'message
MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else 'sinon
'Chemin = répertoire choisi
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
'Choix du 1er fichier
fichier = Dir(Chemin & "*.xls*")
'Colonne = n° de colonne ou on va coller les données
'pour commencer colonne A, laisser à 0, pour commencer colonne B remplacer 0 par 1 etc...
Colonne = 3
'on boucle sur tous les fichiers excel du répertoire choisi
Application.ScreenUpdating = False
Do While Len(fichier) > 0
Colonne = Colonne + 1
If fichier <> ThisWorkbook.Name Then
'attribue un nom dans le classeur, se référant à la plage à importer : B2:I18
ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]Etude'!$B$2:$m$20"
With Sheets("recup")
' "Importe les données" grâce au nom donné ci-dessus
.[B2:M20] = "=Plage"
'.[C3:C6].Copy 'Copie C3:C6'.[B3:B10].Copy 'Copie B3:B10
.[C3].Copy 'Copie C3'.[C3].Copy 'Copie C3
End With
With Sheets("ecris")
.Cells(1, Colonne).PasteSpecial xlPasteValues 'Colle c3
End With.....
End If
fichier = Dir()
Loop
End If
End Sub
Dernière édition:
