Importer fichiers Excel à la suite VBA

Le 05/08/2016 à 13:28

Bonjour à tous,

Je suis débutante en VBA et je cherche à créer une base de données dans un classeur Excel : j'aimerais importer des fichiers Excel (tous le même format) pour former cette base de données. J'ai réussi à créer un bout de code (d'ailleurs grâce à ce forum) me permettant d'importer un fichier, mais lorsque je veux importer un nouveau fichier cela m'écrase les données précédentes. J'aimerais pouvoir les mettre à la suite dès que j'en importe des nouvelles. Si quelqu'un a une idée de ce qu'il faut que je change je suis preneuse!

J'avais pour idée de rajouter une ligne comme ça (mais je ne sais pas où dans mon code) :

derniereLigne = Sheets("feuil1").Range("A65000").End(x1Up).Row

Elle me permettrait de connaître la dernière ligne non vide et donc d'ajouter les nouvelles données à la suite...

Merci de votre aide !

Mon code :

Public Namepatch3 As String

Sub import()

Application.ScreenUpdating = False

Dim Filt As String

Dim IndexFiltre As Integer

Dim NomFichier As Variant

Dim Titre As String

Dim i As Integer

Dim j As Integer

Dim Msg1 As String

Dim ConsoPDC As Workbook

Dim fichier As String

Dim chaine As String

Dim feuille As Variant

Dim Reponse As Integer

Dim Config As Integer

Dim nomClasseur As Variant

Dim vclasseur As Workbook

Dim resum As Workbook

Namepatch3 = ActiveWorkbook.Name

Windows(Namepatch3).Activate

[A65000].End(xlUp).Offset(0, 0).Select

Excel.Application.DisplayAlerts = False

' Définit la liste des filtres de fichiers

Filt = "Fichiers texte (*.txt),*.txt," & _

"Fichiers Lotus (*.prn),*.prn," & _

"Fichiers séparés par des virgules (*.csv),*.csv," & _

"Fichiers ASCII (*.asc),*.asc," & _

"Tous les fichiers (*.*),*.*"

' Affiche *.* par défaut

IndexFiltre = 5

' Définit la légende de la boîte de dialogue

Titre = "Sélectionner les fichiers à traiter"

' Obtenir le nom de fichier

NomFichier = Application.GetOpenFilename _

(fileFilter:=Filt, _

FilterIndex:=IndexFiltre, _

Title:=Titre, _

MultiSelect:=True)

' Quitter si la boîte de dialogue est annulée

If Not IsArray(NomFichier) Then

MsgBox "Aucun fichier n'a été sélectionné!"

GoTo TheEnd

End If

' Affiche le chemin complet et le nom des fichiers

Config = vbYesNo + vbInformation + vbDefaultButton2

For i = LBound(NomFichier) To UBound(NomFichier)

Msg = Msg & NomFichier(i)

Next i

Reponse = MsgBox("Ci-dessous vos fichiers selectionnés :" & vbCrLf & Msg & vbCrLf, Config, _

"MAJ resum")

If Reponse = vbNo Then GoTo TheEnd

For j = LBound(NomFichier) To UBound(NomFichier)

Msg1 = NomFichier(j)

Application.ScreenUpdating = False

Workbooks.Open Filename:=Msg1

Application.Calculation = xlCalculationManual

'Declare le classeur actif

Set wkb = ActiveWorkbook

'Affiche la barre de statut en bas à gauche de l'écran (si elle ne l'est pas déjà)

Application.StatusBar = "MAJ resum - Traitement fichier " & ActiveWorkbook.Name & " - merci de patienter SVP ..."

'------------------------------------------------------------------------------------------------------

'Ne selectionne que le nom du fichier à l'intérieur du chemin

fichier1 = Right(Msg1, Len(Msg1) - InStrRev(Msg1, "\", -1, 1))

fichier = Left(fichier1, InStr(fichier1, ".xls") - 1)

'traitement import

Windows(Namepatch3).Activate

[A65000].End(xlUp).Offset(1, 0).Select

ActiveCell.Value = fichier

ActiveCell.Offset(0, 0).Select

Windows(fichier1).Activate

Range("A2:S65000").Copy 'Donnees à copier : de la cellule A2 à S65000 car plage variable

Windows(Namepatch3).Activate

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

'------------------------------------------------------------------------------------------------------

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

Application.StatusBar = False

'Libération de la ressource

Set wkb = Nothing

Windows(fichier1).Activate

ActiveWorkbook.Close

Next j

[A65000].End(xlUp).Offset(0, 0).Select

TheEnd:

End Sub

Le 05/08/2016 à 13:41

Bonjour et bienvenu !

Je pense lire assez bien le VBA, mais honnêtement, debugger 200 lignes en mode texte de visu semble un peu compliqué

Avant de coller les données, effectivement, il faudra récupérer la dernière ligne écrite, et coller à la suite.

A priori ici :

Windows(Namepatch3).Activate

'Récupère la dernière ligne
DerniereLigne = Sheets("feuil1").Range("A65000").End(x1Up).Row

'Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A" & DerniereLigne).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Pour essayer de répondre à la question, merci de fournir le fichier principal, et un fichier à importer.

Cordialement

Bouben

Le 05/08/2016 à 13:45

Merci de ta réponse si rapide !

Finalement, j'ai posté ce message un peu trop rapidement.. Je viens de trouver la solution à mon problème !!

Il suffisait que je rajoute deux lignes :

Range("A65000").End(xlUp).Offset(1).Select 'recherche la première cellule vide

ActiveSheet.Paste 'copie les données

Et oui, désolée pour les lignes de code en txt... La prochaine fois je joindrai mon fichier.

Merci encore!

Le 05/08/2016 à 13:48

Bonjour,

essaye d'insérer la ligne surlignée

Windows(Namepatch3).Activate
Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Et pitié comme dit plus haut, utilise les balises [code ] [/code ], sinon c'est dur de trouver la motivation d'aider !

Le 05/08/2016 à 13:57

Bonjour Elhevan,

D'après le dernier message, le problème est résolu.

"Finalement, j'ai posté ce message un peu trop rapidement.. Je viens de trouver la solution à mon problème !! "

Cordialement

Bouben

Le 05/08/2016 à 14:03

Merci Elhevan! Ta solution fonctionne très bien aussi.

Désolée, c'était mon premier post ici, je n'ai absolument pas pensé aux balises ni rien.. La prochaine fois je le ferai!

Merci pour votre aide en tout cas

Je n'hésiterai pas à revenir vers vous si j'ai d'autres problèmes !

Le 05/08/2016 à 14:03
bouben a écrit :

Bonjour Elhevan,

D'après le dernier message, le problème est résolu.

"Finalement, j'ai posté ce message un peu trop rapidement.. Je viens de trouver la solution à mon problème !! "

Cordialement

Bouben

Ouip, mais j'avais déjà écrit alors tant qu'à faire

Rechercher des sujets similaires à "importer fichiers suite vba"