XL 2016 Grouper 3 macros

[luke3300]

Bonjour le forum,

J'utilise 3 macros actuellement et j'aimerais les simplifier et n'en avoir qu'une seule.

Voici les codes:

Sub Macro2()
'
' Copie les noms
'

'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Sheets("New").Select
    Range("A5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Distribution").Select
    Range("D26").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False 'supprime le clignotement lié au copier/coller
    Range("F26").Select
    Sheets("Données").Select
    Range("A1").Select
End Sub
Sub Macro3()
'
' Macro3 Macro
'

'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Sheets("New").Select
    Range("D2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Distribution").Select
    Range("F9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Replace What:="J0", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="JS", Replacement:="S", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Application.CutCopyMode = False 'supprime le clignotement lié au copier/coller
    Range("F26").Select
    Sheets("Données").Select
    Range("A1").Select
End Sub
Sub Macro5()
'
' Macro5 Macro
'

'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Sheets("New").Select
    Range("D5").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Distribution").Select
    Range("F26").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Replace What:="2", Replacement:="1", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="3", Replacement:="1", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Application.CutCopyMode = False 'supprime le clignotement lié au copier/coller
    Range("F26").Select
    Sheets("Données").Select
    Range("A1").Select
End Sub

Il s'agit de Macros de copier/coller et de remplacement de valeurs.

Merci d'avance pour l'aide que vous pourrez m'apporter et excellent début de semaine à toutes et tous.

 

[zebanx]

Bonjour luke3300

Tu peux créer une macro qui appelle toutes les autres
Sub 3macros
call macro5
call macro6
call macro..
end sub

@+

 

[luke3300]

Bonjour zebanx,

C'est en effet une solution à laquelle j'avais pensé mais j'aurais aimé en les groupant, les simplifier, les rendre plus ..."Pro" 😉
Mais c'est une option que je garde sous le coude ...

Merci pour ta proposition.

 

[cp4]

Bonjour,

Avec un petit fichier ça aurait été plus pratique.
essaie la 1ère macro, si elle fait le même boulot.

Sub Macro2()
' Copie les noms
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Sheets("New").Range("A5:A" & Sheets("new").Range("A5").End(xlDown).Row).Copy Sheets("Distribution").Range("D26")
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

@+

 

[luke3300]

Bonjour cp4,

Oui, elle fait le boulot espéré.
Merciiii

 

[cp4]

à tester la suivante

Sub Macro3()
   Dim Rng1 As Range, Cell As Variant, dl As Integer
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   Set Rng1 = Sheets("New").Range("D2:D" & Sheets("new").Range("D2").End(xlDown).Row)
   dl = Rng1.End(xlDown).Row

   Rng1.Copy Sheets("Distribution").Range("F9")
   With Sheets("Distribution")
      For Each Cell In .Range("F9:F" & dl)
         Cell.Value = Replace(Cell.Value, "J0", "")
         Cell.Value = Replace(Cell.Value, "JS", "S")
      Next Cell
   End With
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
End Sub

@+

 

[luke3300]

Merci cp4,

Celui-ci par contre ne va pas chez moi ... il colle bien la 1ère donnée (mais pas en tant que valeur) dans la cellule de destination mais juste la 1ère de la série.

 

[cp4]

Merci cp4,

Celui-ci par contre ne va pas chez moi ... il colle bien la 1ère donnée (mais pas en tant que valeur) dans la cellule de destination mais juste la 1ère de la série.

Ainsi, je ne pourrais plus t'aider. Je ne peux pas deviner ce que tu as dans tes plages de cellules.
Joins un petit fichier.
@+

 

[luke3300]

Bonjour cp4, zebanx, le forum,

J'ai fait un petit fichier que je joint ... ce sera plus facile je pense 😉
J'aimerais que les données soient collées en valeur et les plages (tant d'origine que de destinations) sont susceptibles de s'étendre suivant les données dans le sens des flèches que j'ai ajoutés dans le fichier.

Encore merci et bonne journée

 

[cp4]

Bonsoir,

Je n'ai pas compris tu as mis sur la feuille distribution, des validations à 0 ou 1.
Alors que la plage en question est alimentée à partir de la feuille new.
un essai à tester.

Option Explicit

Sub essai1()
   Dim Lfs As Integer, Lfd As Integer, Cfs As Integer, Cfd As Integer
   Dim NbCfd As Intege
   Dim Fs As Worksheet, Fd As Worksheet
   Set Fs = Worksheets("new")
   Set Fd = Worksheets("distribution")

   With Fd 'on vide les lignes et colonnes
      Lfd = .Range("d" & Rows.Count).End(xlUp).Row
      Cfd = .Range("f9").End(xlToRight).Column
      NbCfd = Cfd - 5
      .Range("D26:D" & Lfd).ClearContents
      On Error Resume Next
      .Range(Cells(9, 6), Cells(9, 6 + NbCfd)).ClearContents
      On Error GoTo 0

   End With

   With Fs
      Lfs = .Range("a" & Rows.Count).End(xlUp).Row
      Cfs = .Range("D2").End(xlToRight).Column
      .Range("A5:A" & Lfs).Copy Fd.Range("D26")
      .Range(.Cells(2, 4), .Cells(2, Cfs)).Copy Fd.Range("F9")
      .Range(.Cells(5, 4), .Cells(Lfs, Cfs)).Copy Fd.Range("F26")
   End With

   With Fd
      Dim cel As Range
      Lfd = .Range("d" & Rows.Count).End(xlUp).Row
      Cfd = .Range("f9").End(xlToRight).Column
      For Each cel In .Range(.Cells(9, 4), .Cells(9, Cfd))
         cel = Replace(cel, "J0", "")
         cel = Replace(cel, "JS", "S")
      Next
      For Each cel In .Range(.Cells(26, 5), .Cells(Lfd, Cfd))
         cel = Replace(cel, 2, 1)
         cel = Replace(cel, 3, 1)
      Next
   End With
End Sub

Bonne continuation.

 

[luke3300]

Bonjour cp4, le forum,

Cela fonctionne mais les données sont collées avec les formats etc ... et la colonne C de la feuille New ... alors que le but est de les coller en tant que "valeurs" et de ne pas intégrer les données de la colonne C.
Serait-ce possible?

Merci beaucoup pour ton aide 🙂

 

[cp4]

Bonjour cp4, le forum,

Cela fonctionne mais les données sont collées avec les formats etc ... et la colonne C de la feuille New ... alors que le but est de les coller en tant que "valeurs" et de ne pas intégrer les données de la colonne C.
Serait-ce possible?

Merci beaucoup pour ton aide 🙂

Revoie bien le code, à aucune ligne la colonne C n'est prise en considération. Ce qui veut dire que ses données ne sont pas copiées sur la feuille distribution. Bien sûr, si tu as joint un fichier que ne reprend pas exactement ton fichier original. Là, je perds mon temps. Que veux-tu obtenir d'autre en copiant/collant du texte en tant que valeur; ça sera toujours du texte. Sauf si tu as autre chose que du string (numérique ou formule).
Bonne continuation.

 

[luke3300]

Re cp4 🙂
Non j'utilise bien le fichier que j'ai joint. J'avais bien vu que la colonne C n'est mentionnée nulle part dans le code et c'est pour ça que je l'ai signalé ... dans le fichier de base, la colonne C de la feuille Distribution comporte des formules et lorsque j'active le code, les formules sont remplacées par des nombres.
Merci beaucoup

 

[cp4]

Je pense bien que tu ne m'as pas compris, à quoi bon copier/coller la colonne A qui contient que du texte (A......N) en tant que valeur.
Du texte restera toujours du texte.
Je n'ai pas compris ton insistance pour copier en tant que valeur. Merci d'expliquer.

 

[luke3300]

En fait la macro copie la mise en forme des cellules de départ et en collant, écrase la mise en forme des cellules de destination. Hors j'aimerais conserver la mise en forme de la feuille Distribution. Moi je ne connais que le copié/collé en tant que valeur pour contourner cela ... d'où mon insistance 🙁