Probleme Macro VBa

[kajamiat]

Bonjour à tous,

Je me permets de solliciter votre aide sur une macro que je n'arrive pas à terminer!
Voici ce que je souhaite faire :
J'ai un fichier A avec 3 onglets.
Je souhaite mettre une macro dans un fichier B.Dans le fichier B, dans un seul et même onglet je souhaite rapatrier l'ensemble des données des 3 onglets du fichier A.
Ca j'y arrive pas.
Pourriez vous m'aider svp?

 

[zeltron24]

Re : Probleme Macro VBa

Bonsoir Kajamiat

Un petit fichier sans données personnelles aiderait grandement

 

[Robert]

Re : Probleme Macro VBa

Bonjour le fil, bonjour le forum,

Je suis tout à fait d'accord avec Zeltron et comme lui je me bats pour que les demandes soient accompagnées d'un petit fichier exemple. Je t'ai quand même concocté ce petit bout de code à placer dans le fichier B. Il te faudra bien évidement l'adapter à ton cas vu que tu n'as pas fourni d'exemple... Je ne l'ai pas testé non plus toujours pour la même raison.
le code :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Object 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemon d'Accès)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim NCS As String 'déclare la variable NCS (Nom du Classeur Source)
Dim O As onbect 'déclare la variable O (Onglet)
Dim DEST As Range 'déclare la variable DEST (Cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur de destination CD
Set OD = CD.Sheets("Feuil1") 'définit l'onglet de destination OD
CA = CD.Path & "\" 'définit le chemin d'accès
NCS = "Fichier A.xls" 'définit la nom du classeur source NCS
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la aligne suivante)
Set CS = Workbooks(NCS) 'définit le classeur source CS (génère une erreur si le classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Workbooks.Open (CA & NCS) 'ouvrle le classeur NCS
    Set CS = ActiveWorkbook 'définit le classeur source CS
End If 'fin de la condition
For Each O In CS.Sheets 'boucle sur tous les onglets O du classeur source
    'définit la cellule de destination DEST (A1, si A1 est vide, sinon la seconde cellule vide de la colonne A de l'onglet OD)
    Set DEST = IIf(OD.Range("A").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0))
    O.UsedRange.Copy DEST 'copie la plage éditée de l'onglet et la colle dans dest
Next O 'prochain onglet de la boucle
End Sub

 

[kajamiat]

Re : Probleme Macro VBa

Zeltron, robert
Merci pour votre réponse.
C'est vrai que sans classeur c'est pas pratique.
Du coup, j'ai mis un exemple en piece-jointe.

Merci pour votre aide

 

[Robert]

Re : Probleme Macro VBa

bonsoir le fil, bonsoir le forum,

Kajamiat, as-tu au moins essayé d'adapter le code proposé ? Je l'ai commenté exprès pour que tu puisses le faire sans trop de problème.

 

[kajamiat]

Re : Probleme Macro VBa

Bonsoir à tous
Robert merci pour tes réponses.
Oui j'ai essayé le code, j'ai juste modifié onbect par object et j'ai mis l'adresse du fichier.
j'ai lancé la macro en pas à pas avec la lecture, elle s'execute mais ne rappatrie rien.
je n'ai aucun message d'erreur.
As tu une idée de pourquoi?

 

[Robert]

Re : Probleme Macro VBa

Bonjour le fil, bonjour le forum,

En effet, comme je navet pas testé il y avait quelques erreurs... Ci-dessous le code corrigé. Chaque fois que j'ai mis : '-------> à adapter
Il te faut vérifier la ligne en dessous si ça correspond bien à tes fichiers.
Le code :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Object 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemon d'Accès)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim NCS As String 'déclare la variable NCS (Nom du Classeur Source)
Dim O As Object 'déclare la variable O (Onglet)
Dim DEST As Range 'déclare la variable DEST (Cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur de destination CD
'-------> à adapter
Set OD = CD.Sheets("données") 'définit l'onglet de destination OD
CA = CD.Path & "\" 'définit le chemin d'accès
'-------> à adapter
NCS = "fichier A.xlsx" 'définit la nom du classeur source NCS
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la aligne suivante)
Set CS = Workbooks(NCS) 'définit le classeur source CS (génère une erreur si le classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Workbooks.Open (CA & NCS) 'ouvrle le classeur NCS
    Set CS = ActiveWorkbook 'définit le classeur source CS
End If 'fin de la condition
For Each O In CS.Sheets 'boucle sur tous les onglets O du classeur source
    'définit la cellule de destination DEST (A1, si A1 est vide, sinon la seconde cellule vide de la colonne A de l'onglet OD)
    Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0))
    O.UsedRange.Copy DEST 'copie la plage éditée de l'onglet et la colle dans dest
Next O 'prochain onglet de la boucle
End Sub

 

[kajamiat]

Re : Probleme Macro VBa

Bonjour à tous, Bonjour Robert.

Un grand merci pour ton aide , ca marche!

J’ai juste une question complémentaire.
Comment éviter que lorsqu’il y a les copier-coller vers l’onglet données que cela génère une ligne vide entre les blocs venant des différents onglets?

 

[Robert]

Re : Probleme Macro VBa

Bonjour le fil, bonjour le forum,

remplace :
Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0))
par :
Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))

 

[kajamiat]

Re : Probleme Macro VBa

Bonjour Robert, Bonjour à tous,

Encore merci pour ton aide.

Je me permets de poser une dernière question.

J’ai tenté de compléter la macro avec une nouvelle tache.
Cette tache consiste à dire à partir de la ligne si en colonne 15, tu trouves # ou 0 alors tu supprimes tout.
Cependant, j’ai des messages d’erreurs lorsque j’essaye de compiler ces macros.

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Object 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemon d'Accès)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim NCS As String 'déclare la variable NCS (Nom du Classeur Source)
Dim O As Object 'déclare la variable O (Onglet)
Dim DEST As Range 'déclare la variable DEST (Cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur de destination CD
'-------> à adapter
Set OD = CD.Sheets("données") 'définit l'onglet de destination OD
CA = CD.Path & "C:\Users\Desktop\Fichier B.xlsx" 'définit le chemin d'accès
'-------> à adapter
NCS = "fichier A.xlsx" 'définit la nom du classeur source NCS
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la aligne suivante)
Set CS = Workbooks(NCS) 'définit le classeur source CS (génère une erreur si le classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Workbooks.Open (CA & NCS) 'ouvrle le classeur NCS
    Set CS = ActiveWorkbook 'définit le classeur source CS
End If 'fin de la condition
For Each O In CS.Sheets 'boucle sur tous les onglets O du classeur source
    'définit la cellule de destination DEST (A1, si A1 est vide, sinon la seconde cellule vide de la colonne A de l'onglet OD)
    Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
    O.UsedRange.Copy DEST 'copie la plage éditée de l'onglet et la colle dans dest
Next O 'prochain onglet de la boucle

ligne = 2

While Not Cells(ligne, 2) = ""
    If Cells(ligne, 15) = 0 Then
        Rows(ligne).Delete
        
    If Cells(ligne, 15) = "#" Then
        Rows(ligne).Delete
'        Selection.EntireRow.Delete
    Else
        ligne = ligne + 1
    End If

End Sub

 

[Robert]

Re : Probleme Macro VBa

Bonjour le fil, bonjour le forum,

Supprimer tout après la ligne 15 si il y a un # dans la colonne O d'accord ! Mais de quel classeur parle-t-on ? Source ou Destination ? J'imagine que c'est le classeur Destination mais je préfère avoir confirmation...

 

[kajamiat]

Re : Probleme Macro VBa

Hello à tous
Oui c'est bien le classeur de destination; Désolé !
J'ai du mal taper mon code car je veux supprimer toute la ligne , à partir de la ligne 2 (car la 1 ca sera du texte) si jamais la colonne 15 / O est vide ou # ou 0

 

[Robert]

Re : Probleme Macro VBa

Bonjour le fil, bonjour le forum,

Essaie comme ça :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Object 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemon d'Accès)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim NCS As String 'déclare la variable NCS (Nom du Classeur Source)
Dim O As Object 'déclare la variable O (Onglet)
Dim DEST As Range 'déclare la variable DEST (Cellule de DESTination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable pPL (PLage)
Dim CEL As Range 'déclare la variable R (CELlule)
Dim LI As Integer 'déclare la variable LI (LIgne)

Set CD = ThisWorkbook 'définit le classeur de destination CD
'-------> à adapter
Set OD = CD.Sheets("données") 'définit l'onglet de destination OD
CA = CD.Path & "C:\Users\Desktop\Fichier B.xlsx" 'définit le chemin d'accès
'-------> à adapter
NCS = "fichier A.xlsx" 'définit la nom du classeur source NCS
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la aligne suivante)
Set CS = Workbooks(NCS) 'définit le classeur source CS (génère une erreur si le classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Workbooks.Open (CA & NCS) 'ouvrle le classeur NCS
    Set CS = ActiveWorkbook 'définit le classeur source CS
End If 'fin de la condition
For Each O In CS.Sheets 'boucle sur tous les onglets O du classeur source
    'définit la cellule de destination DEST (A1, si A1 est vide, sinon la seconde cellule vide de la colonne A de l'onglet OD)
    Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
    O.UsedRange.Copy DEST 'copie la plage éditée de l'onglet et la colle dans dest
Next O 'prochain onglet de la boucle
DL = OD.Cells(Application.Rows.Count, 15).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 15 (=O) de l'onglet OD
Set PL = OD.Range("O2:O" & DL) 'définit la plage PL
For Each CEL In PL 'boucle sur toutes les cellules CEL de la palge PL
    If CEL.Value = "" Or CEL.Value = "#" Or CEL.Value = 0 Then LI = CEL.Row: Exit For 'si la cellule est vide ou vaut zéro ou contient "#", définit la variable LI : sort de la boucle
Next CEL 'prochaine cellule de la boucle
OD.Range(OD.Cells(LI, 1), OD.Cells(DL, 1)).EntireRow.Delete 'supprime les lignes concernée
End Sub

Attention, j'ai pris la colonne O comme référence pour définir la dernière ligne éditée mais ce n'est peut-être pas le cas. Tu adapteras :

DL = OD.Cells(Application.Rows.Count, 15).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 15 (=O) de l'onglet OD

 

[kajamiat]

Re : Probleme Macro VBa

Merci !
J’ai une question :
En fait, lorsque je lance la macro dès qu’elle rencontre une ligne qui ne doit pas être là elle est bien supprimée, mais cela bloque la macro dans le sens où elle ne va plus chercher les infos des autres lignes.
Si par exemple, à la ligne 4 elle ne doit pas me remonter l’info elle le fait bien , mais du coup elle ne passe pas sur la ligne 5 qui elle doit être renseignée.
Sais tu pourquoi ?

 

[Robert]

Re : Probleme Macro VBa

Bonjour le fil, bonjour le froum,

J'ai mal interprété ta demande. J'ai cru que tu voulais, à partir de la première ligne rencontrée contenant (vide, 0 ou #), supprimer toutes les lignes en dessous.
En fait tu veux (si j'ai bien compris cette fois), supprimer les lignes qui contiennent (vide, 0 ou #).
Le code modifié :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Object 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemon d'Accès)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim NCS As String 'déclare la variable NCS (Nom du Classeur Source)
Dim O As Object 'déclare la variable O (Onglet)
Dim DEST As Range 'déclare la variable DEST (Cellule de DESTination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim LI As Integer 'déclare la variable LI (LIgne)

Set CD = ThisWorkbook 'définit le classeur de destination CD
'-------> à adapter
Set OD = CD.Sheets("données") 'définit l'onglet de destination OD
CA = CD.Path & "C:\Users\Desktop\Fichier B.xlsx" 'définit le chemin d'accès
'-------> à adapter
NCS = "fichier A.xlsx" 'définit la nom du classeur source NCS
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la aligne suivante)
Set CS = Workbooks(NCS) 'définit le classeur source CS (génère une erreur si le classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Workbooks.Open (CA & NCS) 'ouvrle le classeur NCS
    Set CS = ActiveWorkbook 'définit le classeur source CS
End If 'fin de la condition
For Each O In CS.Sheets 'boucle sur tous les onglets O du classeur source
    'définit la cellule de destination DEST (A1, si A1 est vide, sinon la seconde cellule vide de la colonne A de l'onglet OD)
    Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
    O.UsedRange.Copy DEST 'copie la plage éditée de l'onglet et la colle dans dest
Next O 'prochain onglet de la boucle
DL = OD.Cells(Application.Rows.Count, 15).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 15 (=O) de l'onglet OD
For LI = DL To 2 Step -1 'boucle inversée sur toutes les cellules CEL de dernière ligne DL à la ligne 2
    If OD.Cells(LI, 15).Value = "" Or OD.Cells(LI, 15).Value = "#" Or OD.Cells(LI, 15).Value = 0 Then Rows(LI).Delete 'supprime la ligne
Next CEL 'prochaine cellule de la boucle
End Sub