Discussion :

[remidoubi33]

Bonjour,

voici mon problème (en version simplifié, ça ne correspond pas à mon vrai tableur mais le principe est bien là!):
je voudrais rassembler les valeurs(et seulement les valeurs!!) de 2 paires de colonnes dans une troisième paire.

Il s'agit en fait de coordonnées de points, c'est pour cela que les colonnes vont par paire et aussi les lignes dans chaque colonnes ne doivent pas être mélangées!
Dans les colonnes E&F doivent d'abord apparaitre les valeurs de A&B et ensuite celles de C&D puis des cellules vides.
Le nombre de lignes dans les colonnes A&B et C&D varie en fonction des paramètres.

Savez-vous comment réaliser ceci?

Merci!

Rémi

[remidoubi33]

Je viens de trouver comment joindre mon fichier^^

j'ai été obliger de l'archiver car il est en format .xlsx

voilà!

[Philippe Tulliez]

Bonjour,
Petite parenthèse
Avant d'effectuer du code VBA sur cette feuille, il serait bon de corriger les formules dex colonnes B et D pour éviter ces messages d'erreurs #DIV/0! et #NOMBRE!
Voir du côté des formules de la catégorie Informations ESTERR etc.
Depuis Office 2007 il y a une nouvelle fonction de la catégorie logique SIERREUR mais il faut être certain que toute personne qui lira ce classeur n'aura pas une version antérieure

[Philippe Tulliez]

Bonjour,
Le dépôt de ton classeur est prématuré et je pense parfaitement inutile, l'image est suffisamment claire. De plus le format ZIP est plus courant que le RAR que certaines personnes ne peuvent décompressés.
Voici un code qui devrait répondre à ton problème. IL y a bien sûr d'autres solutions
Ce code recopie les valeurs des cellules pas les formules.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 Dim sht As Worksheet
 Dim RowF As Long, RowT As Long, C As Long
 Dim myCell As Range
 Set sht = ThisWorkbook.ActiveSheet
 RowF = 1: RowT = 1
 With sht
  For C = 1 To 3 Step 2
   Do
    RowF = RowF + 1: Set myCell = .Cells(RowF, 1)
    If myCell Then
     RowT = RowT + 1
     .Cells(RowT, 5) = .Cells(RowF, C): .Cells(RowT, 6) = .Cells(RowF, C + 1)
    End If
   Loop Until myCell = 0
  RowF = 1
  Next C
 End With

[remidoubi33]

Je ne connais rien en VBA (ou que très peu) et je n'arrive pas à comprendre comment sont définies les colonnes dans le code, je ne vois pas de A, B, C, D, E, F. Car dans mon fichier final les colonnes ne sont pas simplement en A, B, C, ... il faudrait donc que je puisse savoir comment les définir!

Merci pour le travail en tout cas

[Philippe Tulliez]

Bonjour,
Le n° des colonnes est défini dans le deuxième argument de l'objet Cells, Cells(ligne, colonne), et c'est un nombre (1 pour A, 5 pour E, etc.)
Si tu ne connais rien en VBA, tu t'es trompé de forum. Je te conseille la lecture de ce didacticiel et celui-là.

[remidoubi33]

Effectivement je ne suis pas un pro de VBA mais ce forum est bien fait pour s'entraider!
Je n'arrive pas à faire fonctionner la macro, au moment de l'exécution il y a une erreur au niveau du "Set" il m'affiche "instruction incorrect à l'extérieur d'une procédure".

[mercatog]

Il fallait nommer la procédure

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub Toto()
'le code proposé
end sub

Mais, il te faudra d(abord lire les bases (cf. liens fournis)

[remidoubi33]

C'est bien ce que j'avais fait! je ne comprends pas pourquoi ça ne fonctionnais pas vendredi, aujourd'hui ça fonctionne...

Je me suis cassé la tête ce week-end et j'ai fait ça (par contre c'est pas sur le modèle de l'Exemple du début) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Private Sub RegroupementDonnees_Click()                                                             
Dim DebRayon As Range
Dim DebDroite As Range
Dim DebRecap As Range
Dim Position As Long
Dim PosDroite As Long
 
Set DebRayon = Range("DebutRayon")                                                                   
Set DebDroite = Range("DebutDroite")
Set DebRecap = Range("DebutRecap")
 
Application.ScreenUpdating = False                                                                        
Range(DebRecap, DebRecap.End(xlDown).Offset(0, 5)).ClearContents                       
Position = 0                                                                                                           
While DebRayon.Offset(Position).Value <> ""                                                           
    DebRecap.Offset(Position).Value = DebRayon.Offset(Position).Value                     
    DebRecap.Offset(Position, 1).Value = DebRayon.Offset(Position, 1).Value              
    DebRecap.Offset(Position, 2).Value = DebRayon.Offset(Position, 2).Value
    DebRecap.Offset(Position, 3).Value = DebRayon.Offset(Position, 3).Value
    DebRecap.Offset(Position, 4).Value = DebRayon.Offset(Position, 4).Value
    DebRecap.Offset(Position, 5).Value = DebRayon.Offset(Position, 5).Value
Position = Position + 1                                                                                           
Wend                                                                                                                    
 
PosDroite = 0                                                                                                         
While DebDroite.Offset(PosDroite).Value <> ""                                                          
    DebRecap.Offset(Position).Value = DebDroite.Offset(PosDroite).Value
    DebRecap.Offset(Position, 1).Value = DebDroite.Offset(PosDroite, 1).Value
    DebRecap.Offset(Position, 2).Value = DebDroite.Offset(PosDroite, 2).Value
    DebRecap.Offset(Position, 3).Value = DebDroite.Offset(PosDroite, 3).Value
    DebRecap.Offset(Position, 4).Value = DebDroite.Offset(PosDroite, 4).Value
    DebRecap.Offset(Position, 5).Value = DebDroite.Offset(PosDroite, 5).Value
    Position = Position + 1                                                                                          
    PosDroite = PosDroite + 1                                                                                     
Wend
Application.ScreenUpdating = True                                                                             
End Sub

Ça à l'air de fonctionner mais je trouve ça à l'air vachement différent de ce que vous m'aviez proposé...