Modification d'une Macro Help SVP

Mister Binaire

XLDnaute Occasionnel
Bonsoir le Forum,

Cette macro voir ci-dessous copie les datas localisés de D1 à 170 de chaque onglet dans l'onglet "Master Data" en colonne.
Je voudrais ( enfin ma hiérarchie) maintenant que les datas soient recopiés en ligne.
Pour être clair recopier les datas de l' onglet 1 dans l'onglet master data de D1 à D170
Recopier l'onglet 2 de D171 à D341
Recopier l'onglet 3 de D342 à D512 etc etc..

Parfois le champs d'un onglet de D1 à D170 n'est pas complet, il peut contenir 20 ou 30 valeurs le top serait que la recopie de l'onglet suivant commence à partir de la dernière valeur du précédent pour éviter les lignes blanches.

Merci de votre aide bien précieuse ...

Sub Macro1()
Dim OD As Object 'déclare la variable OD (Onglet de Destination)
Dim O As Object 'déclare la variable O (Onglets)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OD = Sheets("Master Data") 'définit l'onglet OD
For Each O In Sheets 'boucle sur tous les onglets O du classeur
Select Case O.Name 'agit en fonction du nom de l'onglet O
'cas "Sommaire", "Formulaire Demande", "Formulaire Process" et "Master Data", rien ne se passe
Case "Sommaire", "Formulaire Demande", "Formulaire Process", "Master Data"
Case Else 'tous les autres cas
'définit la cellule de destination DEST (A1 si A1 est vide sinon, la première cellule vide de la ligne 1)
Set DEST = IIf(OD.Range("A1") = "", OD.Range("A1"), OD.Cells(1, Application.Columns.Count).End(xlToLeft).Offset(0, 1))
'condition : si le nombre de valeurs dans la plage est supérieur à 1
If Application.WorksheetFunction.CountA(O.Range("D1:D170")) > 1 Then
O.Range("D1:D170").Copy 'copie la plage D1:D170 de l'onglet O
'colle les valeurs dans DEST
DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If 'fin de la condition
End Select 'fin de la condition
Next O 'prochain onglet de la boucle
End Sub
 

vgendron

XLDnaute Barbatruc
Re : Modification d'une Macro Help SVP

Bonjour,

à mon avis, si tu n'as pas eu de réponse, c'est surement parce qu'il manque un tout petit truc, mais essentiel..
ton fichier exemple ;-)

il faudrait juste que tu postes un exemple (sans data confidentielles) qui soit représentatif de la structure de ton fichier
ainsi, on pourra te proposer une solution adaptée à ton besoin réel. (et tu verra, les solutions vont pleuvoir ;-)
 

vgendron

XLDnaute Barbatruc
Re : Modification d'une Macro Help SVP

autre chose en passant.
tu dis vouloir recopier les datas en ligne. de D1 à D170... ca. c'est en colonne..
en ligne serait de D1 à Z1 par exemple

sinon, pour détecter la dernière cellule non vide
Set DEST = IIf(OD.Range("A1") = "", OD.Range("A1"), OD.Range("A1").End(xlDown))

donc
sinon, pour détecter la dernière cellule vide
Set DEST = IIf(OD.Range("A1") = "", OD.Range("A1"), OD.Range("A1").End(xlDown).offset(1,0))
 

Mister Binaire

XLDnaute Occasionnel
Re : Modification d'une Macro Help SVP

Bonsoir vgendron, Bonsoir le Forum,

Merci de ta réponse vgendron cette dernière me redonne espoir.

Voici en pj le fichier très allégé j'ai uniquement gardé que 4 onglets contenant les données qui doivent être envoyées à l'onglet master data.

Pour récapituler les données de l'onglet "Haze" doivent être copiées dans l'onglet Master Data de A1 à D170 (maximum) puis les données de l'onglet "Gloss) même champs venir se ranger en dessous ainsi de suite pour tous les onglets en évitant les lignes non remplies compris dans le champs A1 à D170.

Merci de votre aide bien précieuse..
 

Pièces jointes

  • STD Work Mister Binaire.xlsm
    131.6 KB · Affichages: 33

vgendron

XLDnaute Barbatruc
Re : Modification d'une Macro Help SVP

Hello

Essai ceci

Code:
Option Explicit
Sub Macro1()
Dim OD As Object 'déclare la variable OD (Onglet de Destination)
Dim O As Object 'déclare la variable O (Onglets)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OD = Sheets("Master Data") 'définit l'onglet OD
For Each O In Sheets 'boucle sur tous les onglets O du classeur
    Select Case O.Name 'agit en fonction du nom de l'onglet O
        'cas "Sommaire", "Formulaire Demande", "Formulaire Process" et "Master Data", rien ne se passe
        Case "Sommaire", "Formulaire Demande", "Formulaire Process", "Master Data"
        Case Else 'tous les autres cas
            'définit la cellule de destination DEST (A1 si A1 est vide sinon, la première cellule vide de la ligne 1)
            'Set DEST = IIf(OD.Range("A1") = "", OD.Range("A1"), OD.Range("A1").End(xlDown).Offset(1, 0))
            Set DEST = OD.Range("A65536").End(xlUp).Offset(1, 0)
            'DEST.Select
            Range(O.Range("A1"), O.Range("A1").End(xlDown).Offset(0, 3)).Copy DEST
            
            'condition : si le nombre de valeurs dans la plage est supérieur à 4
            'If Application.WorksheetFunction.CountA(O.Range("A1:D170")) > 4 Then
            '    O.Range("A1:D170").Copy 'copie la plage A1:D170 de l'onglet O
                'colle les valeurs dans DEST
            '    DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            'End If 'fin de la condition
    End Select 'fin de la condition
Next O 'prochain onglet de la boucle
End Sub
 

vgendron

XLDnaute Barbatruc
Re : Modification d'une Macro Help SVP

Re,

Tu as du reprendre le code posté avant que je ne commente la ligne qui plante

voici le code épuré (sans toutes les lignes qui ne servent à rien que j'avais mises en commentaire.
Je viens de tester sur ton fichier. et je n'ai pas de plantage. ca devrait donc aller

Code:
Option Explicit
Sub Macro1()
Dim OD As Object 'déclare la variable OD (Onglet de Destination)
Dim O As Object 'déclare la variable O (Onglets)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OD = Sheets("Master Data") 'définit l'onglet OD
For Each O In Sheets 'boucle sur tous les onglets O du classeur
    Select Case O.Name 'agit en fonction du nom de l'onglet O
        'cas "Sommaire", "Formulaire Demande", "Formulaire Process" et "Master Data", rien ne se passe
        Case "Sommaire", "Formulaire Demande", "Formulaire Process", "Master Data"
        Case Else 'tous les autres cas
            'définit la cellule de destination DEST (A1 si A1 est vide sinon, la première cellule vide de la ligne 1)
            Set DEST = OD.Range("A65536").End(xlUp).Offset(1, 0)
            Range(O.Range("A1"), O.Range("A1").End(xlDown).Offset(0, 3)).Copy DEST
    End Select 'fin de la condition
Next O 'prochain onglet de la boucle
End Sub
 

Mister Binaire

XLDnaute Occasionnel
Re : Modification d'une Macro Help SVP

Merci à nouveau de ton aide.

Les datas se collent bien dans l'onglet "Master data" mais voici le message d'erreur de la macro que j'obtiens :
 

Pièces jointes

  • Macro.jpg
    Macro.jpg
    92.9 KB · Affichages: 35
  • Macro.jpg
    Macro.jpg
    92.9 KB · Affichages: 38
  • Macro.jpg
    Macro.jpg
    92.9 KB · Affichages: 38

Mister Binaire

XLDnaute Occasionnel
Re : Modification d'une Macro Help SVP

Oui, j'ai repris le fichier original qui comporte tous les onglets et j'ai appliqué une mise en forme à chaque colonne : format STD pour la colonne QUI, format date pour la colonne Quand et format standard pour les n° de roll.

Merci de ton aide !!
 

Mister Binaire

XLDnaute Occasionnel
Re : Modification d'une Macro Help SVP

Bonsoir vgendron, Bonsoir le Forum,

En Pj la version finale qui plante avec tous les onglets, je me demande si cela n'est pas du à la largeur de la colonne D qui varie suivant le titre des attributs.

Il est vrai que dans le fichier d'exemple d'hier la macro ne planque pas mais toutes les colonnes sont de taille identique ?

Si quelqu'un peut m'aider à résoudre ce message d'erreur.
 

Pièces jointes

  • STD Work Trame Process Labo Béta 7.06.zip
    286.2 KB · Affichages: 20
  • STD Work Trame Process Labo Béta 7.06.zip
    286.2 KB · Affichages: 21
  • STD Work Trame Process Labo Béta 7.06.zip
    286.2 KB · Affichages: 20

vgendron

XLDnaute Barbatruc
Re : Modification d'une Macro Help SVP

Salut Mister,

Le problème vient du fait que dans les onglets où sa plante, il n'y a pas de donnée à copier.. à part la ligne de titre.

En faisant la sélection des data vers le haut, ca va mieux ;-)

Code:
Option Explicit
Sub Macro1()
Dim OD As Object 'déclare la variable OD (Onglet de Destination)
Dim O As Object 'déclare la variable O (Onglets)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OD = Sheets("Master Data") 'définit l'onglet OD
For Each O In Sheets 'boucle sur tous les onglets O du classeur
    Select Case O.Name 'agit en fonction du nom de l'onglet O
        'cas "Sommaire", "Formulaire Demande", "Formulaire Process" et "Master Data", rien ne se passe
        Case "Sommaire", "Formulaire Demande", "Formulaire Process", "Master Data"
        Case Else 'tous les autres cas
            'définit la cellule de destination DEST (A1 si A1 est vide sinon, la première cellule vide de la ligne 1)
            Set DEST = OD.Range("A65536").End(xlUp).Offset(1, 0)

            Range(O.Range("A65536").End(xlUp).Offset(0, 3), O.Range("A1")).Copy DEST
            'Range(O.Range("A1"), O.Range("A1").End(xlDown).Offset(0, 3)).Copy DEST
    End Select 'fin de la condition
Next O 'prochain onglet de la boucle
End Sub
 

Mister Binaire

XLDnaute Occasionnel
Re : Modification d'une Macro Help SVP

Bonsoir Vgendron et merci de ta réponse.

Sur un autre poste la solution pour corriger l'erreur m'a été donnée ainsi :

erreur vient de: O.Range("A1").End(xlDown).Row =65536(excel2003 dernière ligne)
changer
Code :
Range(O.Range("A1"), O.Range("A1").End(xlDown).Offset(0, 3)).Copy DEST
par
Code :
Range(O.Range("A1"), O.Range("A65536").End(xlUp).Offset(0, 3)).Copy DEST
 

Discussions similaires

Statistiques des forums

Discussions
312 329
Messages
2 087 327
Membres
103 516
dernier inscrit
René Rivoli Monin