Discussion :

[Rania1990]

Bonjour tout le monde,

Je voudrai copier des cellules non vides dans un nouveau onglet en transposé :

Exemple:

05/04/2018	08/04/2018	10/04/2018
Italy (9h-14h)	Romania	Romania
	Slovenia	Italy
		UK

Ce que je veux avoir :

Date	Pays
05/04/2018	Italy
08/04/2018	Romania
	Slovenia
10/04/2018	Romania
	Italy
	UK

J'ai essayé ce code mais ça ne marche pas

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
Sub CopyPaste()
Dim last_row As Integer: Dim last_column As Integer
Dim j As Integer: Dim i As Integer
Dim HDate, Pays As String
 
Sheets("Holiday").Select
For i = 0 To last_column
  For j = 0 To last_row
  Next j
Next i
     If (Cells(i, j).Value <> "") Then
     A(k) = i(HDate)
     B(k) = j(Pays)
     End If
End Sub

Merci pour votre aide.

[Menhir]

Quand tu fais une boucle, il faut mettre le code concerné par chaque "tour" à l'INTERIEUR de la boucle, c'est-à-dire, dans le cas présent, entre la ligne du "For..." et celle du "Next".

Tu devrais lire ceci : http://silkyroad.developpez.com/vba/boucles/

Cela dit, pour faire une transposée en VBA, deux lignes suffisent :
- un Copy sur la zone source :
https://msdn.microsoft.com/fr-fr/lib.../ff837760.aspx
- un PasteSpecial sur la cellule de destination avec le paramètre Transpose à True :
https://msdn.microsoft.com/fr-fr/lib.../ff839476.aspx

[Rania1990]

Bonjour Menhir,

Voilà ce que j'ai tenté de faire, je bloque sur la partie en gras. En fait je veux copier mes données respectivement dans les colonnes A (date )et B (pays) mais j'y arrive pas. Est ce que tu veux bien m'aider stp? Merci d'avance

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
Sub CopyCC()
Application.ScreenUpdating = False
Dim i As Integer
Dim j As Integer
Dim Last_column As Integer: Dim last_row As Integer
For i = 0 To Last_column
 For j = 0 To last_row
If Cells(i, j).Value <> "" Then
Worksheets("Holiday").Cells(j, i).Copy
Worksheets("Feuil1").Cells(j, i).Paste
 
'A(k) = i
'B(k) = j
' Next j
'Next i
 
End If
 Next j
Next i
Application.ScreenUpdating = True
End Sub

[BENNASR]

Bonjour
j'arrive pas à comprendre ta requete ::: peux tu joindre un capture écran des données de départ et un capture écran du résultat souhaité svp

[Rania1990]

Bonjour Bennasr,


Données :


Résultat souhaité


Merci beaucoup

[BENNASR]

re
aussi débutant en VBA et autodidacte
j'arrive à 50% du chemin
pense avec moi à améliorer ce code
il reste à écrire la date à plusieurs fois si il existe plus qu'un pays
... je continue à chercher et voila le résultat actuel
teste ce code sur une copie de ton travail svp
adapte les noms des onglets si différents
les données de départ supposé commence à partir de la colonne A et la ligne 2

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
With Sheets("feuil2")
.Select
Cells.Select
Selection.ClearContents
Sheets("feuil2").Cells(1, 1).Resize(1, 2) = Array("Date", "Pays")
End With
 
'copier
Dim i As Long
Dim k As Integer
Dim dl As Long
k = 2
Application.ScreenUpdating = False
With Sheets("feuil1")
 A = .Cells(2, Cells.Columns.Count).End(xlToLeft).Column
For j = 1 To A
If .Cells(2, j) <> "" Then
    dl = .Cells(Rows.Count, j).End(xlUp).Row
    Sheets("feuil2").Range("A" & k).Value = .Cells(2, j)
    Sheets("feuil2").Range("B" & k).Value = .Cells(dl, j)
    k = k + 1
    End If
Next j
 
End With
Application.ScreenUpdating = True
End Sub

[BENNASR]

re
Peut être y a une chemin moins courte mais à mon niveau de débutant j'arrive à bricoler ce code qui normalement fait l'affaire
voir avec ça RANIA et bonne continuation

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
Sub TransposerDonnées()
' *************************nétoyer feuille2 
With Sheets("feuil2") ' 
.Select
Cells.Select
Selection.ClearContents
Sheets("feuil2").Cells(1, 1).Resize(1, 2) = Array("Date", "Pays")
End With
 
'********************************copier
Dim i As Long
Dim k As Integer
Dim dl As Long
k = 2
Application.ScreenUpdating = False
With Sheets("feuil1")
 A = .Cells(2, Cells.Columns.Count).End(xlToLeft).Column 'chercher la dernière colonne non vide de la ligne 2 ou se trouve les dates
For j = 1 To A
If .Cells(2, j) <> "" Then
    dl = .Cells(Rows.Count, j).End(xlUp).Row 'derniere ligne de chaque colonne non vide : change au fur et au mesure du changement de la colonne 
    For s = 3 To dl
    Sheets("feuil2").Range("A" & k).Value = .Cells(2, j)
    Sheets("feuil2").Range("B" & k).Value = .Cells(s, j)
    k = k + 1
    Next s
    End If
Next j
 
End With
Application.ScreenUpdating = True
End Sub

[Rania1990]

ça marche parfaitement,
Merci beaucoup Bennasr

[BENNASR]

merci de cliquer sur resolu