Aide sur une Macro

[Mister Binaire]

Bonsoir le Forum,

Voila, j'ai créé avec l’éditeur de macro ce bout de code (voir-ci dessous)

Tout ceci est bien lourd, ce que je voudrais c'est tout simplement de copier les données localisées dans chaque feuilles de D1170 et de les recopier dans l'onglet "Master Data" sans la mise en forme. Le top serait que lorsque la colonne d'une feuille ne contient pas de donnée que celle -ci ne soit pas recopier. (au total 30 feuilles)

Merci à toutes celles et tout ceux qui pourront m'aider.

Sub CopieData()
'
' CopieData Macro
'

'
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Master Data").Select
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Gloss").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Master Data").Select
Columns("B:B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Curling").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Master Data").Select
Columns("C:C").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

 

[Robert]

Re : Aide sur une Macro

Bonsoir Mister Binaire, bonsoir le forum,

Peut-être comme ça :

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
    If Not O.Name = "Master Data" Then 'condition : si le nom de l'onglet n'est pas "Master Data"
        '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"), O.Cells(1, Application.Columns.Count).End(xlToLeft).Offset(0, 1))
        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
Next O 'prochain onglet de la boucle
End Sub

 

[Mister Binaire]

Re : Aide sur une Macro

Bonsoir Robert, Bonsoir le Forum,

Tu es toujours aussi formidable Robert la macro marche presque.

Le problème c'est que les trois premiers onglets ne sont pas des onglets de stat c'est à partir de l'onglet "Haze" que les données doivent être pris en compte . La macro ne copie que partiellement les datas dans l'onglet Master Data certains data sont recopiés sur leur propre feuille ?

En PJ le fichier enrichit pour que tu vois mieux le Pbl.

en tout cas merci de ton aide à l'aube de tes vacances..

 

[Robert]

Re : Aide sur une Macro

Bonsoir Mister Binaire, bonsoir le forum,

Essaie comme ça :

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

 

[Mister Binaire]

Re : Aide sur une Macro

Bonjour Robert, Bonjour le Forum,

Merci de ton aide bien précieuse Robert.

Cela marche mieux, mais je rencontre le problème suivant:

Sur les 5 attributs complétés pour l'exemple par des datas seul 3 sont copiés dans l'onglet Master Data.
La fenêtre de la macro "Attention vous n'avez pas rentrer de spécification" apparaît lors de la recopie et doit être validée 3 fois.
(cette macro localisé sur chaque onglet de stat empêche la personne de rentrer des datas de D1 à D170 si des spécifications ne sont pas mises en F2 ou G2)

Merci une fois de plus de ton aide ..

 

[Robert]

Re : Aide sur une Macro

Bonjour Mister Binaire, bonjour le forum,

Oui, il suffit de la désactiver sur l'onglet Master Data....

 

[Mister Binaire]

Re : Aide sur une Macro

Rebonjour Robert, Rebonjour le Forum,

Comme d'habitude tout marche à merveille après avoir retiré la macro de la feuille Master Data.

Il est logique que les datas ne pouvaient pas se copier puisque la macro les empêchait de se mettre en colonne D.

Une fois de plus merci de ton aide Robert le STD Works est pratiquement terminé il manque juste un brin de cosmétique.

Bonnes Vacances Robert et encore une fois merci !!!