Copie de cellules non adjacentes

[Faithful]

Bonjour à toutes et à tous ; suis dans le brouillard depuis une dizaine d'heures pour quelque chose de vraisemblablement très simple pour la majorité d'entre vous ! Soit des valeurs numériques disposées dans des cellules souvent non adjacentes dans une colonne (exemple G10 ; G12; G17 ; G18; G20; G26) Comment recopier ces valeurs dans des cellules adjacentes cette fois et dans une ligne (exemple en A1; B1; C1; D1; E1; F1) ? Il est bien évident que les valeurs numériques de la colonne G ne seront pas toujours dans les mêmes cellules (dans cet exemple, la valeur qui est en G10 aujourd'hui sera peut-être en G3 demain) et que le nombre de valeur peut être différent d'un jour à l'autre ... J'ai essayé avec des 'Transpose' puis des suppressions de lignes vides mais ce n'est pas sérieux !!! Un grand merci à celles et ceux qui voudront bien se pencher sur mon pb.

 

[Robert]

Bonjour Faithful, bonjour le forum,

Si tu dois sélectionner certaines valeurs parmi d'autres, je te propose de sélectionner les cellules (avec Ctrl pour pouvoir sélectionner des cellules non adjacentes) puis de lancer la macro ci-dessous :

Sub Macro1()
Dim cel As Range 'déclare la variable cel
Dim x As Integer 'déclare la variable x

x = 1 'définit la varaible x
For Each cel In Selection 'boucle sur toutes les cellules sélectionnées
Cells(1, x).Value = cel.Value 'tranpose la valeur
x = x + 1 'redéfinit la variable x
Next cel 'prochaine cellule de la sélection

End Sub

Si entre les valeurs que tu désires les cellules sont vides, pas besoin de sélectionner, avec celle-ci :

Sub Macro2()
Dim cel As Range 'déclare la variable cel
Dim x As Integer 'déclare la variable x
Dim Pl As Range 'déclare la variable Pl

Set Pl = Range('G1:G' & Range('G65536').End(xlUp).Row) 'définit la variable Pl

x = 1 'définit la varaible x
For Each cel In Pl 'boucle sur toutes les cellules éditées de la colonne G
If cel.Value <> '' Then
Cells(1, x).Value = cel.Value 'tranpose la valeur
x = x + 1 'redéfinit la variable x
End If
Next cel 'prochaine cellule de la sélection

End Sub

 

[Faithful]

Re... Merci Robert pour cette réponse rapide. Je ne souhaite pas sélectionner moi-même les cellules contenant une valeur mais que cela se fasse automatiquement ...

 

[PascalXLD]

Bonjour

une autre façon

Option Explicit

Sub toto()

Dim x As Integer, y As Integer, maligne As Integer

maligne = Range('G65536').End(xlUp).Row

For x = 2 To maligne
&nbsp; &nbsp; If Range('G' & x) <> '' Then
&nbsp; &nbsp; &nbsp; &nbsp; y = y + 1
&nbsp; &nbsp; &nbsp; &nbsp; Cells(1, y) = Range('G' & x)
&nbsp; &nbsp; End If
Next

Rows('2:' & maligne).Delete

End Sub

Bon courage

 

[Faithful]

Re Le Forum ; merci Robert et Pascal76. Cela fonctionne ... MAIS : il est évident que pour l'exemple, on simplifie au maximum ; en fait les valeurs sont dans la colonne R dans des cellules non adjacentes de R111 à R159. La copie doit se faire dans la ligne 100 en commençant par la cellule A1. J'ai essayé d'adapter mais des nèfles : aucune maîtrise du VBA !!! Pouvez-vous m'aider ? merci

 

[PascalXLD]

Re

Entre nous je ne vois pas ce que ta première demande a de plus simple que la réalité de ta question (à part faire faire 2 fois la macro LOL)

Bon alors la macro modifiée en comprenant que lorsque tu dis 'en commençant par la cellule A1' tu entends en fait A100

Option Explicit

Sub toto()

Dim x As Integer, y As Integer

For x = 111 To 159
If Range('R' & x) <> '' Then
y = y + 1
Cells(100, y) = Range('R' & x)
End If
Next

Rows('111:159').Delete

End Sub

Message édité par: Pascal76, à: 09/11/2005 11:40

 

[Faithful]

Un grand merci Pascal76, c'est tout bon et de plus, en comparant les deux codes, je crois comprendre ...
Je te souhaite une excellente journée