Coller des données après la dernière cellule non vide

Le 08/10/2018 à 09:43

Bonjour à tous,

Je suis débutante en macro et je rencontre quelques difficultés...

L'objectif de la macro est de récupérer des données provenant de 6 fichiers et de les coller dans un seul et même onglet.

Ma problématique est que je n'arrive pas à coller les données les unes après les autres.

Ci-dessous ma macro :

Dim derniereligne As Integer

Dim ficheure As String, fictech As String, chmtech As String, ficcms As String, chmcms As String

------> Ouverture du 1ier Fichier

Workbooks.Open Filename:= _

chmtech, _

UpdateLinks:=0

Sheets("CP").Visible = True

Sheets("CP").Activate

derniereligne = Range("B65536").End(xlUp).Row

Range("B5:NC" & derniereligne).Copy

Windows(ficheure).Activate

Sheets("CP").Select

derniereligne = Range("B65536").End(xlUp).Row

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

:=False, Transpose:=False

-------> Ouverture du 2nd Fichier

Workbooks.Open Filename:= _

chmcms, _

UpdateLinks:=0

Sheets("CP").Visible = True

Sheets("CP").Activate

derniereligne = Range("B65536").End(xlUp).Row

Range("B5:NC" & derniereligne).Copy

Windows(ficheure).Activate

Sheets("CP").Select

derniereligne = Range("B65536").End(xlUp).Row

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

:=False, Transpose:=False

Pourriez-vous m'expliquer ce qui ne va pas dans mon codage ?

Je vous remercie par avance pour vos réponses et vous souhaite une excellente journée

Nina

Le 08/10/2018 à 10:07

Yo Nina ! Yo le Forum !

Ma problématique est que je n'arrive pas à coller les données les unes après les autres.

Faut faire une boucle

Est-ce que tout tes fichiers sont réunies dans le même dossier ?

Si oui c'est tout tout simple !

Sub ListFiles()
Dim Fichier As String, Chemin As String
Dim i As Long, x As Long, a As Long, v As Long
Chemin = "P:\PERSONNEL\Excel\" 'ICI TU MET TON PROPRE CHEMIN ;D
Fichier = Dir(Chemin)
i = Range("G" & Rows.Count).End(xlUp).Row
If Fichier <> "" Then
    Do While Fichier <> ""
        i = i + 1
        Sheets(1).Cells(i, 7) = Chemin & Fichier
        Sheets(1).Cells(i, 8) = Fichier
        Fichier = Dir
    Loop
End If

End Sub

Le code ci-dessus te permet de faire la liste de tes fichiers dans le chemin indiqué !

Option Explicit
Public NewClasseur As Long

Faut que tu mette sa dans ton module pour savoir si tu ouvre un nouveau classeur ou non !

Sub OpenFiles()
Dim x As Long, i As Long, a As Long, y As Long
Dim MonFichier As String, Files As String, Way As String
Dim classeur As Workbook
If NewClasseur = 0 Then
    Set classeur = Application.Workbooks.Add 'creer un new classeur
    With classeur
        .SaveAs 'ICI LE CHEMIN DE SAUVEGARDE DE TON NOUVEAU FICHIER
    End With
Else
    Workbooks("ICI TON NEW FICHIER.xlsx").Activate
End If
Sheets.Add.Name = "Onglet" 'créer un onglet
Workbooks("ICI TON FICHIER OU SONT LISTER TES FICHIERS.xlsm").Activate
x = Range("G" & Rows.Count).End(xlUp).Row
Application.DisplayAlerts = False
y = 0
For i = 2 To x
    If Cells(i, 7) <> "" And Cells(i, 8) <> "" Then
        Way = Cells(i, 7)
        Files = Cells(i, 8)
        Workbooks.Open Filename:="" & Way & ""
        a = Range("A" & Rows.Count).End(xlUp).Row
        If y = 0 Then
            Range("A1:AZ" & a).Copy
        Else
            Range("A2:AZ" & a).Copy
        End If
        Workbooks("ICI TON NEW FICHIER.xlsx").Activate
        If y = 0 Then
            a = Range("A" & Rows.Count).End(xlUp).Row
        Else
            a = Range("A" & Rows.Count).End(xlUp).Row + 1
        End If
        y = 1
        Cells(a, 1).Select
        ActiveSheet.Paste
        Cells(1, 1).Select
        Workbooks(Files).Close savechanges:=False
        Workbooks("ICI TON NOM FICHIER OU SONT LISTER TES FICHIERS.xlsm").Activate
    End If
Next
Application.DisplayAlerts = True
Columns("G:H").Select
Selection.ClearContents
NewClasseur = 1
End Sub

Ce code la ci-dessus va ouvrir tout les fichiers lister un par un et les copier / coller dans un nouveau classeur et dans le même onglet

Tu peux adapter ces codes à ta manière ou les utiliser tel quel !

Restant à dispo !

Le 08/10/2018 à 10:13

Bonjour Juice,

Je te remercie pour ta réponse rapide !

Oui, tous les fichiers se trouvent dans le même dossier.

Je vais essayer d'adapter ma macro en fonction des indications que tu m'as donné.

Je reviens vers toi pour te tenir au courant du résultat

Le 08/10/2018 à 10:22

Bonjour,

Il y a de nombreuses choses qui ne vont pas dans le codage, avant même de se demander pourquoi ça ne fonctionne pas, pourquoi recopier les mêmes lignes plusieures fois, alors que tu peux utiliser des goto / gosub et return? ou alors appeler une sous fonction?

On va reprendre étape par étape ton programme et voir ce qui ne va pas, et par quoi il faut le remplacer :

Dim derniereligne As Integer

Dim ficheure As String, fictech As String, chmtech As String, ficcms As String, chmcms As String

premier soucis :

Spoiler

Dim derniereligne As Integer

Dim ficheure As String, fictech As String, chmtech As String, ficcms As String, chmcms As String

------> Ouverture du 1ier Fichier

Workbooks.Open Filename:= _

chmtech, _

UpdateLinks:=0

Sheets("CP").Visible = True

Sheets("CP").Activate

derniereligne = Range("B65536").End(xlUp).Row

Range("B5:NC" & derniereligne).Copy

Windows(ficheure).Activate

Sheets("CP").Select

derniereligne = Range("B65536").End(xlUp).Row

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

:=False, Transpose:=False

-------> Ouverture du 2nd Fichier

Workbooks.Open Filename:= _

chmcms, _

UpdateLinks:=0

Sheets("CP").Visible = True

Sheets("CP").Activate

derniereligne = Range("B65536").End(xlUp).Row

Range("B5:NC" & derniereligne).Copy

Windows(ficheure).Activate

Sheets("CP").Select

derniereligne = Range("B65536").End(xlUp).Row

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

:=False, Transpose:=False

On voit double, la partie bleue et rouge ont exactement les mêmes lignes, il n'y a que le nom du fichier qui change, en clair tu utilises la même fonction à chaque fois, mais au lieu de juste changer la valeur d'une variable, tu recopies le code...

Pour régler ça, tu peux utiliser un gosub par exemple, qui va au sub souhaité, je te mets un exemple qui affiche un message (dans ce cas c'est vrai que le gosub n'est pas préférable, mais c'est un exemple) :

exemple :

Sub message()
texte = "coucou"
GoSub afficher 'pour aller au sous-programme
texte = "test"
GoSub afficher

Exit Sub 'à mettre avant les sub

afficher: 'syntaxe d'un sub "nom + :"
MsgBox (texte)
Return 'return pour revenir au programme principal

End Sub

Si on applique cette méthode à ton programme on obtient ça :

Dim derniereligne As Integer
Dim ficheure As String, fictech As String, chmtech As String, ficcms As String, chmcms As String

'Ouverture du 1er Fichier / pas de i pour 1er ;)
 nomfichier = chmtech 'au fait, tu fais appelles à la variable chmtech, mais tu ne la remplis jamais,
 'ça marche quand même? il faudrait mettre le nom du fichier dedans
gosub copie 
'Ouverture du 2ème fichier
 nomfichier = chmcms
gosub copie

 exit sub

 copie:
 Workbooks.Open Filename:= _
 nomfichier, _
 UpdateLinks:=0

 Sheets("CP").Visible = True
 Sheets("CP").Activate

 derniereligne = Range("B65536").End(xlUp).Row
 Range("B5:NC" & derniereligne).Copy

 Windows(ficheure).Activate
 Sheets("CP").Select
 derniereligne = Range("B65536").End(xlUp).Row
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 return

 end sub

Bon le soucis du doublon est reglé car on stocke le nom du fichier dans la variable nomfichier, mais tu utilises des variables de nom de fichier dont tu déclares le format, mais dans lesquelles tu ne mets rien, à ce rythme autant directement utiliser nomfichier en mettant directement le nom, sans passer par d'autres variables, non?

On passe maintenant aux autres soucis dans le programme :

Spoiler

Dim derniereligne As Integer

Dim ficheure As String, fictech As String, chmtech As String, ficcms As String, chmcms As String

'Ouverture du 1er Fichier

nomfichier = chmtech

gosub copie

'Ouverture du 2ème fichier

nomfichier = chmcms

gosub copie

exit sub

copie:

Workbooks.Open Filename:= _

nomfichier, _

UpdateLinks:=0

Sheets("CP").Visible = True

Sheets("CP").Activate

derniereligne = Range("B65536").End(xlUp).Row

Range("B5:NC" & derniereligne).Copy

Windows(ficheure).Activate

Sheets("CP").Select

derniereligne = Range("B65536").End(xlUp).Row

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

:=False, Transpose:=False

return

end sub

Bon... Tout ce qui est en rouge est à remettre en question, parce que je vois plein de choses qui ne sont plus à faire en programmation, les select sont à éviter.

Le Sheets("CP").select peut-être remplacé par un With Sheets("CP") si nécessaire, ou encore set feuilCP = sheets("CP") et vider l'objet via un set feuilCP = nothing en fin d'utilisation

ensuite:

derniereligne = Range("B65536").End(xlUp).Row

Range("B5:NC" & derniereligne).Copy

tu n'es pas obligée de mettre cette valeur dans derniereligne comme tu ne l'utilises qu'à un endroit, mais tu peux garder ça si tu le souhaites, en revanche, ne laisses pas le 65536 pour le nombre de lignes, ce programme ne fonctionnerait plus sur des versions d'Excel possédant plus de lignes, utilises plutôt la variable Rows.coutn qui s'adapte en fonction du fichier (ça donnera "B" & rows.count)

Bon, la copie c'est pareil, pas recommandé, mais si tu veux la garder, tu peux, sinon tu peux aussi stocker les lignes remplies dans un tableau et dérouler les données via des boucles.

Ensuite:

Sheets("CP").Select

derniereligne = Range("B65536").End(xlUp).Row

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

:=False, Transpose:=False

ça c'est pareil, ne pas mettre Sheets("CP").select, plutôt utiliser des with ou des set

Ici tu enregistres derniereligne mais tu ne l'utilises pas, c'est sûrement aussi pour ça que ton programme ne marche pas, tu ne vas jamais à la dernière ligne, la copie... tu peux la garder, mais tu peux aussi utiliser des tableaux VBA.

Je te laisse voir tous les commentaires et corriger ton programme en conséquence, bon courage

EDIT:Oups je suis en retard, tu peux regarder aussi mes commentaires si tu le souhaite, salut Juice au passage

Le 08/10/2018 à 11:07

Bonjour Ausecour,

J'avais déclaré mes fichiers comme ci-dessous :

Sheets("Table").Select

ficheure = ThisWorkbook.Name

fictech = Range("B7").Value

chmtech = Range("B2").Value & "\" & fictech

ficcms = Range("B3").Value

chmcms = Range("B2").Value & "\" & ficcms

Je te remercie pour toutes ces informations, je ne connaissais pas du tout les gosub.

Je vais essayer,

Merci beaucoup !

PS: J'aimerai apprendre davantage les macros. Aurais-tu par hasard un livre assez simple et complet à me recommander ?

Le 08/10/2018 à 11:12

Bonjour,

Ah ça me rassure alors, pour les livres je ne saurais te conseiller... Car je n'en n'ai jamais acheté, j'apprends sur le terrain, en revanche, ce forum est une vraie mine d'informations, tu peux y retrouver des programmes faits par d'autres membres et qui sont très bien écrits

Sinon tu dois pouvoir trouver des sources un peu partout en fonction des informations que tu cherches

PS: tu peux aussi trouver de nombreuses choses via l'explorateur d'objet, ou en mode espionnage via le débogueur de VBA, quand tu veux regarder ce que contient un objet cellule par exemple

Il y a aussi l'aide de microsoft qui peut bien dépanner

Le 08/10/2018 à 11:45

Coucou Ausecour !

Re Nina,

PS: J'aimerai apprendre davantage les macros. Aurais-tu par hasard un livre assez simple et complet à me recommander ?

Ah ça me rassure alors, pour les livres je ne saurais te conseiller... Car je n'en n'ai jamais acheté

Pour ma part, je me suis lancé dans la VBA en commençant par suivre ce cours : https://www.excel-pratique.com/fr/vba.php qui t'apprend les bases de la VBA et te donne des exercices corrigés !

Qui plus est, il provient de ce Forum ;D (n'est-il pas parfait ??)

Le 08/10/2018 à 11:54

Super !

Je vous remercie vraiment tous les deux pour votre aide !

Je vais m'entrainer pour approfondir les macros et connaître plus de notions, comme par exemple les gosub Cela va beaucoup me servir !

Le 08/10/2018 à 17:00

Je vous dérange de nouveau ^^

J'ai une autre petite question concernant la variable "nomfichier".

La macro fonctionne très bien pour la partie CP, mais arrivée à la partie RTT, cela bloque à cause de : "Workbooks(nomfichier).Activate"

J'ai essayé de remplacer String par Workbook mais dans ce cas là l'erreur provient de : "chmtech = Range("B2").Value & "\" & fictech"

J'ai également essayé de le remplacer par Windows comme pour "Windows(ficheure).Activate" qui lui fonctionne très bien, sans succès...

Pour quelle raison ai-je une erreur ? J'ai du mal déclarer la variable nomfichier.

Dim nomfichier as string, ficheure as string

chmtech = Range("B2").Value & "\" & fictech

nomfichier=chmtech

GoSub copie

nomfichier = chmcms

GoSub copie

copie:

Workbooks.Open Filename:= _

nomfichier, _

UpdateLinks:=0

Sheets("CP").Visible = True

Sheets("CP").Activate

derniereligne = Range("B" & Rows.Count).End(xlUp).Row

Range("B5:NC" & derniereligne).Copy

Windows(ficheure).Activate

Sheets("CP").Select

derniereligne = Range("A" & Rows.Count).End(xlUp)(2).Select

ActiveSheet.Paste

Workbooks(nomfichier).Activate

Sheets("RTT").Visible = True

Sheets("RTT").Activate

derniereligne = Range("B" & Rows.Count).End(xlUp).Row

Range("B5:NC" & derniereligne).Copy

Windows(ficheure).Activate

Sheets("RTT").Select

derniereligne = Range("A" & Rows.Count).End(xlUp)(2).Select

ActiveSheet.Paste

Je vous remercie pour votre aide

Le 08/10/2018 à 18:28

Bonjour,

Je pense que le soucis c'est que la fonction workbooksopen attend un string qui contient également le chemin du fichier, alors que workbooks.activate attend juste le nom du classeur, il est déjà ouvert, donc il n'a plus besoin de connaître le chemin, il faut que tu utilises 2 variables, une qui aura le nom complet avec le fichier, une qui aura seulement le nom du fichier, c'est sûrement pour ça que ça refuse de fonctionner

Rechercher des sujets similaires à "coller donnees derniere vide"