Copier/coller des cellules non vides d'une plage définie sur une seule ligne d'une page différente

Version imprimable

04/03/2018, 22h44
JA83140

1 pièce(s) jointe(s)

Copier/coller des cellules non vides d'une plage définie sur une seule ligne d'une page différente

Bonjour à tous,
Nouveau sur le forum et novice en programmation VBA, après des recherches, tests et adaptation (avec mes maigres connaissances actuelles) de différents codes proposés, je ne parviens toujours pas à résoudre mon problème.
Je souhaite mettre en oeuvre une macro pour me permettre de copier sur une seule ligne et dans une feuille différente, les cellules non vides d'une plage de la feuille active définie (C20:G27) pouvant variée de 2 à 8 lignes. Chaque ligne ne possède qu'une seule cellule remplie mais de manière aléatoire.

Pièce jointe 357003

Je parviens, pour le moment à copier les différentes cellules, mais pas sur une seule ligne.
J'ai absolument besoin d'un petit coup de main pour la solution.

Merci pour votre ... précieuse aide
05/03/2018, 07h56
unparia

Bonjour
Je vais personnellement d'abord te guider.
Puis voir ce que tu en fais (et ne revenir t'aider qu'au vu de cet effort) --->>
1) dresser la plage plage des cellules concernées (t'intéresser à ce propos à la méthode specialcells (à lire dans ton aide VBA interne)
2) s'agissant d'une plage de cellules discontinues, on ne peut la copier directement par la méthode Range.copy.
Une telle plage discontinue est toutefois composée de sous-plages continues : ces sous-plages sont des objets Area (à lire dans ton aide VBA interne)
pour chaque plage Area, de la plage plage -->> méthode range.copy
Copier avec quelle destination ? --->> la ligne de ton choix et la colonne (1 au départ) que tu augmentes du nb d'articles de chaque area après avoir procédé à la copie de cet area)

Montre-moi ce que tu fais (tentes au moins de faire) sur ces bases.

EDIT : correction de la méthode --->>
Ne pas décomposer en areas (car difficulté si 2 - ou plus - cellules composent un area)
modifier donc le 2) ainsi :
dire que la colonne C ou copier = 0
Pour chaque cellule de la plage Plage, ajouter sa valeur en colonne C + 1, à la ligne L choisie pour la copie.

je viens de le faire -->> 4 lignes de code très simple sur les bases que je t'ai indiquées.
Et on pourrait n'en avoir que 3 (plus besoin de la variable C) si chaque ligne contenait forcément une donnée
05/03/2018, 08h50
patricktoulon

re

re
Bonjour
"chaque ligne n'a qu'une seule cellule remplie"
heu oui dans ta capture il y en a deux sur chaques lignes une rouge/une noire????????

avoir représenté deux exemples dans une meme capture peut preter a confusion ;)

re
il y a plusieurs solutions diverses et variées
perso la methode areas +copy paste me semble un peu moulin et pareil dans un tableau car il faudrait sous boucler sur les cells des areas contigues

une methode peu ortodoxe mais qui fonctionne quand meme
recuperation de l'adresse de la plage des cellule occupées
replace des ":" par "," conversion en array avec split ,remplacement des addresse par les valeurs des cellules(address)
j'ai utilisé les meme emplacement que dans ta capture
1°

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub TEST1()
    Dim plage As Range, plage2 As Range, tabl As Variant, i As Long
    With ActiveSheet
        Set plage = .Range("C20:G28")
        Set plage_intermediaire = plage.SpecialCells(xlCellTypeConstants)
        tabl = Split(Replace(plage_intermediaire.Address, ":", ","), ",")
        For i = 0 To UBound(tabl)
            tabl(i) = .Range(tabl(i))
        Next
        Debug.Print Join(tabl, ",")
        .Range("j23").Resize(1, UBound(tabl)) = tabl
    End With
End Sub

2°
methode avec boucle sur les CELLS de la plage des specialcells(xlcelltypeconstant) qui reste la plus sur et plus ortodoxe

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub TEST3()
    Dim plage As Range, plage2 As Range, tabl As Variant, i As Long
    With ActiveSheet
        Set plage = .Range("C20:G28")
        Set plage2 = plage.SpecialCells(xlCellTypeConstants)
        ReDim tabl(plage2.Cells.Count)
        For Each cel In plage2.Cells
            i = i + 1: tabl(i - 1) = cel
        Next
        'Debug.Print Join(tabl, ",")
        .Range("j23").Resize(1, UBound(tabl)) = tabl
    End With
End Sub

3° que je proscrit
dans ce prototype de boucle je proscrit la methode boucle sur areas il peut y avoir plusieurs cells contigues dans un area s'a m'obilgerait a sous boucler
je te le met quand meme au cas ou il y aurait des cell contigues dans un/des areas tu pourrais ainsi observe la coquille

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'methode boucle areas peut etre problematique si il il y a un/des areas multicell(contigues)exemple("c20:c21")
Sub TEST2()
    Dim plage As Range, plage2 As Range, tabl As Variant, i As Long
    With ActiveSheet
        Set plage = .Range("C20:G28")
        Set plage2 = plage.SpecialCells(xlCellTypeConstants)
        ReDim tabl(plage2.Areas.Count)
        For i = 1 To plage2.Areas.Count
            tabl(i - 1) = plage2.Areas(i).Value
        Next
        'Debug.Print Join(tabl, ",")
        .Range("j23").Resize(1, UBound(tabl)) = tabl
    End With
End Sub

edit :
4°
dans la boucle for each cells faire une iteration d'une variable "i" et donner la valeur a la cells ligne22,"i").offset(i)

Code:

1
2
3
4
5
6
7
8
9
10
Sub TEST4()
    Dim plage As Range, plage2 As Range, i As Long
    With ActiveSheet
        Set plage = .Range("C20:G28")
        Set plage2 = plage.SpecialCells(xlCellTypeConstants)
          For Each cel In plage2.Cells
         i = i + 1: Cells(22, "I").Offset(0, i) = cel.Value
          Next
     End With
End Sub

bref solution il y a ;)

05/03/2018, 10h04
unparia

A JA83140 :
1) je souhaite vraiment que tu t'y mettes sur les bases que je t'ai indiquées (en tenant compte de mon EDIT en ce qui concerne le point 2)
C'est ainsi, que tu progresseras.
2) et ce d'autant que le tout se fait en seulement 3 lignes de code vraiment simples y compris si l'on compte dans ces "trois" lignes celles de début (for .. to ...) et de fin (Next) de la boucle à mettre en oeuvre.

Je compte sur toi pour me montrer que tu souhaites vraiment t'impliquer un peu ;)
05/03/2018, 10h44
Marc-L
Bonjour !

Juste en s'appuyant sur les simples fonctions de feuille de calculs d'Excel INDEX & SUPPRESPACE
donc sans SpecialCells et en cinq lignes de code …
Code:

1 2 3 4 5 6 Sub Demo1() For R% = 1 To 8 S$ = S$ & Join(Application.Index([C20:G27].Value, R)) Next [D80:K80].Value = Split(Application.Trim(S)) End Sub
___________________________________________________________________________________________________________

:arrow: Merci de cliquer sur :plusser: en bas à droite de chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

___________________________________________________________________________________________________________
Je suis Paris, Egypte, Nigeria, New-York, Mogadicio, Barcelone, London, Manchester, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …
05/03/2018, 10h48
unparia

Bonjour Marc,
Même pas. C'est d'une extrême simplicité pour peu qu'il applique ce que je lui ai indiqué.
Mais je lui laisse d'abord la main (sinon il ne progressera pas vraiment). Même s'il se trompe (et je corrigerai alors).
05/03/2018, 11h05
patricktoulon

re

@marcl joliiiii
j'y avais pas pensé

attention tout de meme que le demandeur est selon lui un novice autant commencer par des boucle ou fonction vba simples

ta methode est simple au premier abords pour un averti mais il faut d'abords maitriser la fonction index (ligne/colonne) sur un range ou variable tableau

edit: ainsi que faire la différence entre trim de vb et application.trim qui n'ont pas la meme fonction et donc resultat différent je l'avais oublié celle la merci pour le coup d'aiguille;)

bien vu en tout cas j'adore le style
05/03/2018, 11h07
Marc-L

Salut Jacques !

Comme je n'aime pas SpecialCells et là ne gagnant rien à l'utiliser
(même nombre de lignes de code mais c'est vrai plus simple à appréhender pour un débutant),
c'était aussi un peu pour Patrick et puis je n'allais pas donner ta solution …

Salut & merci Patrick !
05/03/2018, 11h13
unparia

Mais ... même pas besoin (moi non plus) d'utiliser specialcells ;)
Et surtout : merci de ne pas avoir donné directement la solution (ce sera bien qu'un débutant tente d'abord). :ccool:
05/03/2018, 11h24
patricktoulon

re

perso j'aime bien specialcells pour des petites plages

comme je l'ai precisé en reéditant mon message Marc bien faire la difrence entre

machin=trim(" a b c d e f g h ")
et
machin= application.trim(" a b c d e f g h ")

elle font pas la meme chose

;)
05/03/2018, 11h27
Marc-L

C'est pour cela j'ai bien mis en avant « les fonctions de feuille de calculs d'Excel INDEX & SUPPRESPACE » …
05/03/2018, 12h10
patricktoulon

re

j'aimerais bien connaitre en tout cas le code de ce caractere present dans toute cellule meme vide ce n'est pas chr(160 )ca c'est sur ni chr(1) je n'ai jamais trouvé
j'ouvrirais une discussion a ce sujet
05/03/2018, 12h20
unparia

Une cellule AFFICHE une donnée. Elle ne CONTIENT rien.
Mais cet aspect est ici hors sujet.
05/03/2018, 13h30
JA83140

Bonjour,

Un grand MERCI à toutes les personnes qui se sont penchées sur mon problème.

J'ai réussi à obtenir dans vos réponses le résultat souhaité même si je n'ai pas forcement tout compris.

Encore merci

Je ne sais pas ce que tu as finalement écrit, mais regarde comme c'était simple.
Exemple de tes images --->>
Code:

1 2 3 For Each a In Worksheets("Eval").Range("C20:G27").Cells If a.Value <> "" Then Worksheets("Pde_1").Range("D80:X80")(a.Row - 19) = a.Value '--->> je vais "généreusement" jusqu'à X (confortable) Next