XL 2019 simplifier un code

[chinel]

Bonjour tout le monde ! J'ai un code que je voudrais simplifier , merci
Dans mon cas, je dois copier des cellules dans la colle M mais peut-on le raccourcir ou dois-je mettre toute la même procédure que dans mon exemple ?
Les cellules à copier sont: B8,B10,B11,B12,B13,B14,B15,B17,B19,B20,B21,B22,B25,B26,B27,B28,B29,G8,G10,G11,G12,G13,G14,G15,G17,G19,G20,G21,G22,G237 (B8 étant déjà fait)

Dim Derlig&

With Sheets("Planning")
Derlig = .Range("M" & .Rows.Count).End(xlUp).Row + 1

.Range("M" & .Range("M" & .Rows.Count).End(xlUp).Row + 1).Value = Sheets("Planning").Range("B8").Value

.Range("M2:M" & Derlig + 1).RemoveDuplicates Columns:=1, Header:=xlNo
end with

 

[chinel]

Bonsoir
Bon je viens de passer un peu de temps pour t'écrire une petite macro qui te permet te faire ce que tu veux
La SEULE condition est de recopier ta liste de cellules concrète dans la SUB
Donc un morceau de ta liste de cellules dans la Sub à adapter !!
C'est juste une idée !!! selon ce que j'ai compris ...... Puisque PAS DE FICHIER joint ??

Merci je vais adapter si j'y arrive votre code à mon fichier

 

[chinel]

re
oui autant pour moi je n'avais pas vu qu'il y avait 2 colonnes

Sub test()
Dim p1 As Range, p2 As Range
With Feuil1                                           'feuille  à adapter
        Set p1 = .Range("B8,B10:B15,B17,B19:B22,B25:B29")
        Set p2 = .Range(" G8,G10:G15,G17,G19:G22,G237")
        p1.SpecialCells(xlCellTypeConstants).Copy .Cells(Rows.Count, "M").End(xlUp).Offset(1)
        p2.SpecialCells(xlCellTypeConstants).Copy .Cells(Rows.Count, "M").End(xlUp).Offset(1)

        .Range("M:M").RemoveDuplicates 1, xlNo
    End With
End Sub

Regarde la pièce jointe 1158963

Merci mais j'ai un débogage au niveau de:
p2.SpecialCells(xlCellTypeConstants).Copy .Cells(Rows.Count, "M").End(xlUp).Offset(1)

 

[patricktoulon]

Bonjour
comme tu le vois dans la capture ça fonctionne
c'est de l'utilisation basique des fonctions vba d'excel
si ça déraille c'est que tu a un soucis avec certaines librairies

 

[chinel]

Bonjour
comme tu le vois dans la capture ça fonctionne
c'est de l'utilisation basique des fonctions vba d'excel
si ça déraille c'est que tu a un soucis avec certaines librairies

Sûrement, je dois adapter ton code vis-à-vis du mien, merci de ton soutien

 

[chinel]

Bonjour
comme tu le vois dans la capture ça fonctionne
c'est de l'utilisation basique des fonctions vba d'excel
si ça déraille c'est que tu a un soucis avec certaines librairies

Cela fonctionne si je remets un nouveau bouton de commande avec ta macro mais peut-on l'incorporer dans ceci et sans ta mise en forme, svp ? Merci

Sub Archivage()
If MsgBox("Le planning est-il complet ?", vbYesNo + vbQuestion, "Archivage") = vbNo Then Exit Sub
Dim F As Worksheet, lig&, c As Range, n%
Set F = Sheets("Personnel")
lig = F.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
F.Cells(lig, 1) = Sheets("Planning").[B1] 'date
For Each c In Sheets("Planning").[B8,B10:B15,G8,G10:G15,B17,B19:B22,G17,G19:G23,B25:B29] 'plage adaptable
n = n + 1
F.Cells(lig, n + 1) = c.Value

Next
F.Cells(lig, 1).Resize(, n + 1).Borders.Weight = xlMedium 'bordures
F.Columns.AutoFit 'ajustement largeurs
'F.Activate 'facultatif
F.[A1].CurrentRegion.Name = "T" 'plage nommée
Worksheets("Planning").PrintPreview
Range("B4,B5,B8,B10,B11,B12,B13,B14,B15,B17,B19,B20,B21,B22,B25,B26,B27,B28,B29,G8,G10,G11,G12,G13,G14,G15,G17,G19,g20,g21,g22,g23,C8,c10,c11,c12,c13,c14,c15,c17,c19,c20,c21,c22,c25,c26,c27,c28,c29,h8,h10,h11,h12,h13,h14,h15,h17,h19,h20,h21,h22,h23").Select
Selection.ClearContents

ActiveWorkbook.Save
End Sub

 

[patricktoulon]

re
non la seule adaptation que tu a à faire c'est le nom de la feuille
le reste c'est du générique

là où tu me dis que ça plante, ça soulève plutôt un soucis de librairies

regarde peut être dans outils références si tu n'a pas des manquantes par hasard

très souvent des librairies manquantes génèrent des erreurs infondées

 

[patricktoulon]

tiens celle là copy sans le format (juste les valeurs )

Sub test()
Dim p1 As Range, p2 As Range
With Feuil1                                           'feuille  à adapter
        Set p1 = .Range("B8,B10:B15,B17,B19:B22,B25:B29")
        p1.SpecialCells(xlCellTypeConstants).Copy
        .Cells(Rows.Count, "M").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)

        Set p2 = .Range(" G8,G10:G15,G17,G19:G22,G237")
        p2.SpecialCells(xlCellTypeConstants).Copy
        .Cells(Rows.Count, "M").End(xlUp).Offset(1).PasteSpecial (xlPasteValues)

        .Range("M:M").RemoveDuplicates 1, xlNo
    End With
End Sub

après pour ton archivage je comprends pas bien ce que tu essaie de faire
si tu nous le disais dans un français intelligible sans passer par le langage informatique

 

[patricktoulon]

attention!!
quand tu fait une boucle for each il te faut préciser sur quoi tu boucle

ceci c'est pas bon

For Each c In Sheets("Planning").[B8,B10:B15,G8,G10:G15,B17,B19:B22,G17,G19:G23,B25:B29] 'plage adaptable

ceci est mieux (avec .Cells à la fin du string du range )

For Each c In Sheets("Planning").[B8,B10:B15,G8,G10:G15,B17,B19:B22,G17,G19:G23,B25:B29].cells 'plage adaptable

pourquoi:
et bien parce que tu a déclaré C comme range
et si tu precise pas ca peut etre des ligne entieres ou des colonnes entieres

 

[chinel]

attention!!
quand tu fait une boucle for each il te faut préciser sur quoi tu boucle

ceci c'est pas bon

For Each c In Sheets("Planning").[B8,B10:B15,G8,G10:G15,B17,B19:B22,G17,G19:G23,B25:B29] 'plage adaptable

ceci est mieux (avec .Cells à la fin du string du range )

For Each c In Sheets("Planning").[B8,B10:B15,G8,G10:G15,B17,B19:B22,G17,G19:G23,B25:B29].cells 'plage adaptable

pourquoi:
et bien parce que tu a déclaré C comme range
et si tu precise pas ca peut etre des ligne entieres ou des colonnes entieres

J'ai un debogage voir fichier en annexe, merci

 

[patricktoulon]

re
je viens de tester ton fichier tu a effectivement un vbprojet non enregistré dans tes références
ça sent bien le fichier excel corrompu ça

 

[chinel]

re
je viens de tester ton fichier tu a effectivement un vbprojet non enregistré dans tes références
ça sent bien le fichier excel corrompu ça
Regarde la pièce jointe 1159033

fichier corrompu ? Ma version Office est originale

 

[Dranreb]

Bonjour.
En effet ce n'est pas ça. "NON ENREGISTRÉ : VBAProject" est simplement le projet VBA d'un nouveau classeur ouvert en même temps que celui ayant le projet dont on consulte les références.