XL 2019 simplifier un code

chinel · 27 Décembre 2022

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

dev_co · 27 Décembre 2022

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 ??

chinel · 29 Décembre 2022

dev_co à dit:
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 · 29 Décembre 2022

patricktoulon à dit:

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

VB:

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 · 29 Décembre 2022

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 · 29 Décembre 2022

patricktoulon à dit:
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 · 29 Décembre 2022

patricktoulon à dit:
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 · 29 Décembre 2022

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 · 29 Décembre 2022

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

VB:

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 · 29 Décembre 2022

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

ceci c'est pas bon

VB:

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 )

VB:

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 · 29 Décembre 2022

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

ceci c'est pas bon

VB:

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 )

VB:

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 · 29 Décembre 2022

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 · 29 Décembre 2022

patricktoulon à dit:
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 · 29 Décembre 2022

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.

XL 2019 simplifier un code

chinel

XLDnaute Impliqué

dev_co

chinel

XLDnaute Impliqué

chinel

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

chinel

XLDnaute Impliqué

chinel

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

chinel

XLDnaute Impliqué

Pièces jointes

patricktoulon

XLDnaute Barbatruc

chinel

XLDnaute Impliqué

Dranreb

XLDnaute Barbatruc

Discussions similaires