Recuperer données macro
Bonjour à tous.
Je suis en train de faire une macro permettant de récupérer des informations dans plusieurs fichiers excel.xlsx ayant le même format.
- Le problème du fichier "recupdata" est qu'il récupère bien les données mais il réécrit par dessus les données récupéré précédemment et donc je me retrouve avec une seule ligne de données.
Je pense que le problème vient de cette partie du code, mais je bloque complètement dessus... :
Range("A70:Z70").Select
Selection.Copy
Selection.Copy Destination:=principal.Sheets(1).Range("A" & principal.Sheets(1).UsedRange.Rows.Count)- Je pense également que mon code pourrait être optimisé car, la macro fait planté excel parfois...
Savez-vous comment je pourrais solutionner ces problèmes ?
Je joins le fichier contenant la macro et les fichiers.xlsx ayant le même format.
Merci d'avance
Ardoudou
bonjour
tu dois apprendre Excel avant VBA
mets tous tes fichiers de données dans un unique classeur Windows
fais : menu Données, obtenir, "de classeur"
la magie opère
dans le module Power Query qui te montre les données, menu Accueil, Charger
quelques clics, pas de VBA
à chaque évolution des fichiers de données, faire Actualiser.
Excel est génial !
Si j'avais que quelques fiches à récupéré, oui j'aurais fais ca.
Ce ne sont pas des fichiers qui sont actualisé.
Mais là c'est pour plus de 1500 fichiers excel, ce qui me ferais 1500 lignes de données en gros.
Donc je sais pas si c'est un gain de temps d’insérer les 1500 fichiers via le Power query..
Bonjour à tous,
Une petite coquille dans ton code. Quand tu retournes coller les données, il faut ajouter une ligne à la procédure "UsedRange.Rows.Count" afin de coller juste en dessous.
Selection.Copy Destination:=principal.Sheets(1).Range("A" & principal.Sheets(1).UsedRange.Rows.Count + 1)ric
Rebonjour à tous,
Je t'invite à éviter les "select" qui ralentissent et occupent beaucoup de place.
Au lieu de :
'copier la longitude
Range("G2").Select
Selection.Copy
Range("T70").Select
ActiveSheet.Paste
Utilise :
'copier la longitude
Range("G2").Copy Range("T70") ric
Bonjour à tous,
Ton code légèrement modifié pour le même résultat ...
Option Explicit
Sub importDonnees()
Dim principal As ThisWorkbook
Dim repertoire As String, fichier As String
Dim NbLignes As Integer
Dim isrc As Long
Dim idest As Long
Application.ScreenUpdating = False
' efface les données présentes dans "récupération"
Sheets("recuperation").Rows("2:10000").ClearContents '
Set principal = ThisWorkbook
repertoire = ThisWorkbook.Path
ChDir repertoire
fichier = Dir("*.xls") 'cherches les fichier .xls dans le meme répertoire que le fichier actuel
Do While fichier <> ""
If fichier <> principal.Name Then
Workbooks.Open fichier
On Error GoTo suivant
Sheets("Relevé").Visible = True
With Sheets("Relevé")
On Error GoTo 0
On Error Resume Next
' """TEST"""
'.[A:A].Insert Shift:=xlToRight
'.Range("A2:A" & .[b65536].End(xlUp).Row) = Left(fichier, Len(fichier) - 4)
'.UsedRange.EntireRow.Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
' Poteau orange
Range("A70").FormulaR1C1 = "POTEAU_EXISTANT_ORANGE"
' Copier le nom = N°d appui
Range("C70") = Range("A7").Text
' Ligne ou on récupere toutes les infos
idest = 70
' Récuperer le type de poteau
For isrc = 7 To 13
If Range("B" & isrc).Font.Bold = True Then Range("D" & idest).Value = "POTEAU" & " " & Range("B" & isrc).Value
' Recuperer la hauteur du poteau
If Range("C" & isrc).Font.Bold = True Then Range("F" & idest).Value = Range("C" & isrc).Value
Next isrc
'Code postale et ville
Range("J70") = Range("E3").Text
'Adresse
Range("K70") = Range("E2").Text
'copier la longitude
Range("T70") = Range("G2")
' Copier la latiture
Range("S70") = Range("G3")
'Date de creation ptx
Range("X70") = Range("H2:H3").Text
Selection.Copy
Range("A70:Z70").Copy Destination:=principal.Sheets(1).Range("A" & principal.Sheets(1).UsedRange.Rows.Count + 1)
End With
Sheets("Relevé").Visible = False
ActiveWorkbook.Close False
End If
suivant:
If err.Number = 9 Then MsgBox "Pas de feuille ""synth"" dans le fichier " & fichier, vbExclamation: ActiveWorkbook.Close False
fichier = Dir
Loop
Application.ScreenUpdating = True
End Sub
ric
Merci pour vos réponses.
ric, La macro marche nickel ! Merci beaucoup !
Jmb, je vais étudier le sujet, parce que j'ai déja utilisé plusieurs fois Power Pivot pour utiliser des données d'autres fichiers qui étaient mis à jour. Mais je ne savais pas qu'on pouvais récupérer toutes les fichiers d'un même dossier en même temps. Merci pour l'info !
Ardoudoux