Importer des données d'un doc externe
Bonjour,
Je me permets de vous contacter car j’ai besoin d’une aide sur un document.
Tous les matins, nous imprimons un récapitulatif pour le travail.
Nous saisissons ensuite manuellement ces données dans un suivi.
Une mise à jour permet désormais d’extraire ce récapitulatif en Excel.
Je me suis donc dit : « Bingo, on va pouvoir automatiser la tâche ».
Sauf que le « bingo » devient moins fun car je suis incapable de réaliser cette macro.
Malgré mes recherches sur le net, je n’y arrive pas.
Ce que je souhaiterais que la macro réalise :
1. Je sélectionne dans une boite de dialogue le récapitulatif au format Excel.
2. La macro ajoute les données à mon suivi et fait un tri par date.
Ca a l’air simple mais là où je bloque c’est que je n’ai besoin que des régions « Ouest », « Est », « Nord » et « Sud ».
Autre inconvénient, les données peuvent parfois être décalées sur la droite, l’extraction est loin d’être parfaite, les infos ne sont pas toujours sur la même colonne…
Enfin, comme vous le verrez, la zone « Sud » est particulière (seule une ligne sur deux est à importer)
Pouvez-vous m’aider ?
Je vous joins un récapitulatif exemple, mon tableau de suivi vierge et mon tableau de suivi avec les infos dont j’ai besoin.
Merci d’avance à tous,
Excellente journée,
Loïc
bonjour
Autre inconvénient, les données peuvent parfois être décalées sur la droite, l’extraction est loin d’être parfaite, les infos ne sont pas toujours sur la même colonne…
il faut absolument que les fichiers soient de forme figée.
mais il peut y avoir des différences entre Est et Ouest et Nord...
Est du 15/04/17 doit avoir la même forme que Est du 14/04/17
à voir avec le programmeur de ton ERP/GPAO/GMAO
nota : si tu y parviens, il doit exister même une solution sans VBA
Re,
Merci pour ta réponse
En fait, je ne peux pas demander de modifications car le logiciel est international et je ne peux pas demander un changement pour moi uniquement…
Concrètement les données se décalent par exemple d’une colonne sur la droite mais ce sera du coup la même colonne pour l’ensemble des données dessous.
Ma réponse suffit-elle ? Est-ce possible ?
Merci encore,
Bonne journée,
Loic
Bonjour,
Alors tout d'abord je pense que c'est possible en VBA
Concernant le décalage il faut boucler honrizontalement et vérifier le nom de l'entête. Ensuite pour le sud, il suffis avec une condition de récupérer les lignes ayant une valeur dans "groupe de codes".
Je vais essayer de le faire/commencer si j'ai le temps.
Merci infiniment !
C'est très gentil
Bonne journée,
Loic
Je pensais qu'il y avait un début de code mais non
Ce que tu veux c'est que tous les jours sur ton document "rendu suivi" en cliquant sur le bouton ça ajoute les données ?
Si oui, il y a plusieurs techniques faisable. Faire une ptite popup qui te demande l'emplacement du fichier télécharger, qui l'ouvre copie les données sur une autre feuille, les tris puis les insère sur ta feuille.
C'est la solution la plus complexe à mettre en place mais c'est assez performant.
Sinon tu peux faire une macro complémentaire accessible depuis tous les classeurs qui tri les données du fichier téléchargé puis tu fait un copié collé.
Je dois vraiment choisir ?
Car si c'est le cas, je choisis la première solution ...
Merci a toi,
Bonne journée,
Loic
Ehehn tu choisis si c'es toi qui code
Là je fais la deuxième solution car c'est bien plus simple. Mais je vais chercher si j'ai pas un exemple pour la première solution.
Au top
Meric à toi !
Loic
Bon voilà le code de la macro :
Sub format()
Dim Last As Integer
Dim Region As String
Dim NFeuille As Worksheet
Last = Range("A65536").End(xlUp).Row
Sheets("Sheet1").Cells.UnMerge
Set NFeuille = Sheets.Add(After:=Sheets(Sheets.Count))
Sheets(1).Select
For i = 16 To Last
If Range("A" & i).Value <> "" Then
For j = 1 To 100 'Je boucle 100 colonnes par ce que.. je sai pas la mise en page du fichier est pas top
If Range(LetCol(j) & i).Value = "Nord" Or Range(LetCol(j) & i) = "Sud" Or Range(LetCol(j) & i) = "Est" Or Range(LetCol(j) & i) = "Ouest" Then
For k = 1 To 100
If Range(LetCol(k) & i).Value = "" Then
Columns(LetCol(k) & ":" & LetCol(k)).Delete
End If
Next
End If
Next
Else
Range("A" & i & ":" & "A" & i).EntireRow.Delete
End If
Next
Last = Range("A65536").End(xlUp).Row
For i = 16 To Last
If Range("A" & i).Value <> "" Then
For j = 1 To 8
If Range(LetCol(j) & i).Value = "Nord" Or Range(LetCol(j) & i) = "Sud" Or Range(LetCol(j) & i) = "Est" Or Range(LetCol(j) & i) = "Ouest" Then
Dim LastF1 As Integer
MsgBox (LastF1)
LastF1 = Sheets(2).Range("A65536").End(xlUp).Row
LastF1 = LastF1 + 1
Sheets(2).Range("A" & LastF1).Value = Range("G" & i).Value
Sheets(2).Range("B" & LastF1).Value = Range("A" & i).Value
Sheets(2).Range("C" & LastF1).Value = Range("B" & i).Value
Sheets(2).Range("D" & LastF1).Value = Range("C" & i).Value
Sheets(2).Range("E" & LastF1).Value = Range("D" & i).Value
Sheets(2).Range("F" & LastF1).Value = Range("E" & i).Value
End If
Next
End If
Next
End Sub
Function LetCol(numCol)
LetCol = Split(Cells(1, numCol).Address, "$")(1)
End Function
C'est pas très propre, il y a des points à améliorer mais tu as une bonne base pour comprendre (et c'est utilisable)
Après tu export ta macro. Tu l'ajoute comme macro complémentaire puis tu pourra l'utiliser sur chaque classeur. Donc quand tu télécharge le matin ton fichier tu a juste l'executer sur ce dernier et copier coller les données.
Hej,
Le boulot se fait bien
Si tu veux, afin d'avancer sur la proposition 1, j'ai ce code d'un autre tableau.
J'ai tenté de mixer le tout mais je n'y arrive pas
Sub ImportSwipNoSwip()
Dim TablIni, i As Long, derlig As Long, x As Long
Dim Chemin As String, Fichier As String, Plus As String
'acquisition du chemin d'acces aux fichiers ˆ importer
Chemin = SelectionFichier(ThisWorkbook.Path & "\", "Selection du dossier contenant les fichiers a importer", "", "Dossier")
'Crit_res pour fonction Dir et premiere lecture
Fichier = Dir(Chemin & "\*.xls")
'Boucle de pr_-recherche
'Condition de sortie normale : Nom de fichier sans "_Fait" et longueur de fichier inf_rieure ˆ 21
'Condition de sortie anticip_e : Chemin vide (Suite ˆ s_lection box) ou plus de fichier
Suivant:
If Chemin = "" Then MsgBox "Annulation": Exit Sub ': Si chemin vide message et sortir
If Fichier = "" Then MsgBox "Ce dossier ne contient pas le type de fichier attendu": Exit Sub: ' Si Fichier vide message et sortie
If InStr(1, Fichier, "_Fait") > 0 Or Len(Fichier) > 20 Then Fichier = Dir: GoTo Suivant
'Boucle principale d'importation
Do
Application.ScreenUpdating = False
'Importation
Workbooks.Open Chemin & "\" & Fichier, ReadOnly:=True 'Ouverture du fichier ˆ synth_tiser en lecture seule
derlig = Workbooks(Fichier).ActiveSheet.Range("J" & Rows.count).End(xlUp).Row
TablIni = Workbooks(Fichier).ActiveSheet.Range("A2:Q" & derlig)
With ThisWorkbook.Worksheets("Donnees Swip No Swip")
x = .Range("A" & Rows.count).End(xlUp).Row
For i = LBound(TablIni) To UBound(TablIni)
If TablIni(i, 16) <> 0 Then
If TablIni(i, 12) <> True Then
Select Case TablIni(i, 9)
Case 99
Case Else
' ecritures
x = x + 1
.Cells(x, 1) = TablIni(i, 10)
.Cells(x, 2) = TablIni(i, 9)
End Select
End If
End If
Next
End With
'Vidage des objets m_moire
Set Dico = Nothing
Set inter = Nothing
'Fermeture du fichier trait_ sans sauvegarde
Workbooks(Fichier).Close False
'Modification du nom pour ne pas le retraiter
Plus = ""
Boucle:
On Error Resume Next
Name Chemin & "\" & Fichier As Chemin & "\" & Replace(Fichier & Plus, ".xls", "_Fait.xls")
If Err.Number <> 0 Then Plus = "_Ano": GoTo Boucle
On Error GoTo 0
'Recherche du nom du fichier suivant
Bis:
Fichier = Dir
If InStr(1, Fichier, "_Fait") > 0 Or Len(Fichier) > 20 Then GoTo Bis
'Reprend si un fichier correspondant aux attentes est trouv_
Loop Until Fichier = ""
Application.ScreenUpdating = True
MsgBox "Traitement terminé.", , "C'est Fini"
Sheets("Swip - No Swip").Select
End Sub
Est-ce que ca peut t'aider ?
Encore merci pour l'aide,
Bonne soirée,
Loic
Je regarderais si j'ai du temps.
Mais en gros, tu importe fichier le tableau téléchargé ( c'est peut être ce que fais le code que tu as posté mais j'ai juste survolé ).
Puis tu applique mon code en mettant dans ta feuille les données.
Bonjour à tous,
Après plusieurs recherches, je viens de trouver comment faire
Pour ce que ca interresse je mets le code ci-dessous.
Pas sûr qu'il soit parfait ni rien, mais il fait le boulot !
Un immense merci pour l'aide et l'accompagnement !
Excellent journée,
Loic
Sub TRANSFERT()
' Déclaration des variables
Dim ligne As Integer
Dim i As Integer
Dim Last As Integer
Dim Region As String
Dim NFeuille As Worksheet
Dim SFeuille As Worksheet
Dim DerniereLigne As Integer
Set SFeuille = ActiveSheet
Application.ScreenUpdating = 0
' Initialisation de la variable ligne à 2 (la ligne 1 est la ligne des titres)
ligne = 1
' Boucle permettant de sélectionner plusieurs fichiers
' Sélection du classeur source à partir d'une fenêtre
cheminfichier = Application.GetOpenFilename("Fichiers Excels (*.xls), *.xls")
' Si on clique sur Annuler dans la fenêtre, on sort de la boucle
If cheminfichier = False Then
End If
'Ouverture du classeur source
Workbooks.Open cheminfichier
If Err.Number <> 0 Then
'j'ouvre le fichier 2
Application.Workbooks.Open cheminfichier
End If
On Error GoTo 0
' Récupération du nom du classeur + extension
For i = Len(cheminfichier) To 1 Step -1
If Mid(cheminfichier, i, 1) = "\" Then Exit For
Next
Nomfichier = Mid(cheminfichier, i + 1, Len(cheminfichier))
With Nomfichier
Last = Range("A65536").End(xlUp).Row
Sheets("Sheet1").Cells.UnMerge
Set NFeuille = Sheets.Add(After:=Sheets(Sheets.Count))
Sheets(1).Select
For i = 16 To Last
If Range("A" & i).Value <> "" Then
For j = 1 To 100 'Je boucle 100 colonnes par ce que.. je sai pas la mise en page du fichier est pas top
If Range(LetCol(j) & i).Value = "Nord" Or Range(LetCol(j) & i) = "Sud" Or Range(LetCol(j) & i) = "Est" Or Range(LetCol(j) & i) = "Ouest" Then
For k = 1 To 100
If Range(LetCol(k) & i).Value = "" Then
Columns(LetCol(k) & ":" & LetCol(k)).Delete
End If
Next
End If
Next
Else
Range("A" & i & ":" & "A" & i).EntireRow.Delete
End If
Next
Last = Range("A65536").End(xlUp).Row
For i = 16 To Last
If Range("A" & i).Value <> "" Then
For j = 1 To 8
If Range(LetCol(j) & i).Value = "Nord" Or Range(LetCol(j) & i) = "Sud" Or Range(LetCol(j) & i) = "Est" Or Range(LetCol(j) & i) = "Ouest" Then
Dim LastF1 As Integer
LastF1 = Sheets(2).Range("A65536").End(xlUp).Row
LastF1 = LastF1 + 1
Sheets(2).Range("A" & LastF1).Value = Range("G" & i).Value
Sheets(2).Range("B" & LastF1).Value = Range("A" & i).Value
Sheets(2).Range("C" & LastF1).Value = Range("B" & i).Value
Sheets(2).Range("D" & LastF1).Value = Range("C" & i).Value
Sheets(2).Range("E" & LastF1).Value = Range("D" & i).Value
Sheets(2).Range("F" & LastF1).Value = Range("E" & i).Value
End If
Next
End If
Next
DerniereLigne = Sheets(2).Range("A65536").End(xlUp).Row
Sheets(2).Range("A1:F" & DerniereLigne).Copy
End With
SFeuille.Activate
ActiveSheet.Cells(Rows.Count, "A").End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues
' Fermeture du classeur source
Application.DisplayAlerts = False
Workbooks(Nomfichier).Close SaveChanges:=False
' Incrémentation du numéro de ligne
ligne = ligne + 1
Call classer
Range("A6").Select
Application.ScreenUpdating = 1
End Sub
Function LetCol(numCol)
LetCol = Split(Cells(1, numCol).Address, "$")(1)
End Function