Discussion :

[SimoX1]

Bonjour,
Un peu difficile d'expliquer avec des mots, voici un exemple:

J'ai deux feuilles sur excel :

Code :

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

1
2
3
4
5
6
7
8
9
10
        Countries  |  Date
        ---------------------------
        France     | jun-13
        Belgium    | jun-13
        U.S        | aug-13
        Canada     | sept-13
        Sweden     | oct-13
        Norway     | oct-13
        Finland    | oct-13
        ...        | ...

et (résultat attendu) dans une seconde feuille :

Code :

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

1
2
3
4
5
6
7
 
          jun-13   |  jul-13   |  aug-13   |  sep-13   |  oct-13   |  ...
        --------------------------------------------------------------------------------
          France   |           |    U.S    |  Canada   |  Sweden   |
          Belgium  |           |           |           |  Norway   |
                   |           |           |           |  Finland  |
                   |           |           |           |           |

Je souhaite ainsi afficher les pays comme sur le second tableau en utilisant seulement les informations du premier. (J'ai beaucoup de données à traiter et les dates sont susceptibles de changer, donc pas moyen de le faire manuellement)

Merci !

[crissud]

Bonjour

Facile, Copier/Coller spéciale avec transposer


Cordialement

[gFZT82]

Bonjour,

Voici une solution avec une macro VBA.
Chacun des couples Pays / Mois est examiné.
Le numéro du mois est relevé grâce à la fonction Month. Ce numéro est également celui de la colonne en feuille 2 qui correspond au même mois.
Il ne reste plus qu’à trouver le numéro de ligne où effectuer l’ajout puis copier le nom du pays.

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
Option Explicit
Private Sub Transferer_Click()
Dim Ws2 As Worksheet
Dim Plage As Range, Cel As Range
Dim Lig As Long
Dim Col As Integer
    Set Ws2 = Worksheets("Feuil2")
    With Worksheets("Feuil1")
        'On détermine la plage qui contient la liste des pays
        Set Plage = .Range(.Range("A2"), .Range("A2").End(xlDown))
        'On examine chaque couple pays/mois de cette plage
        For Each Cel In Plage
            'On relève le numéro du mois. On détermine ainsi le numéro de colonne de _
            la feuille 2 où sera effectué le collage
            Col = Month(Cel.Offset(0, 1))
            'On recherche le numéro de ligne où sera effectué le collage
            Lig = Ws2.Cells(Ws2.Rows.Count, Col).End(xlUp).Row + 1
            'On copie le nom du pays
            Ws2.Cells(Lig, Col) = Cel.Value
        Next Cel
        Set Plage = Nothing
    End With
End Sub

Cordialement.

[Philippe Tulliez]

Bonjour,
Une autre proposition.
La procédure de transpose nommée TransposeByDate avec 3 arguments dont le dernier est optionnel et permet de garder ou pas les colonnes ne contenant pas de valeur.
La plage doit contenir 2 colonnes et les dates doivent être en colonne 2.
Il y a un contrôle sur le nombre de colonnes mais pas de test s'il n'y a pas de dates dans la colonne 2
Le formatage des dates sur le tableau transposé n'est pas fait.
Procédure d'appel

Code :

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

1
2
3
4
5
6
7
8
Sub mainTranspose()
 Dim shtFrom As Worksheet, shtTo As Worksheet
 With ThisWorkbook
  Set shtFrom = .Worksheets("Feuil1")
  Set shtTo = .Worksheets("Feuil3")
 End With
 TransposeByDate shtFrom.Range("A6").CurrentRegion, shtTo.Range("G3")
End Sub

Procédure de transposition des données

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
38
39
40
41
42
Sub TransposeByDate(rngFrom As Range, rngTo As Range, Optional EmptyColumn As Boolean)
 ' rngFrom ' Range de base ' ex A2:B15
 ' rngTo   ' Cellule de transfert ' ex F2
 ' [EmptyColumn] ' Valeur Booleenne si TRUE garde les mois non rempli (False par défaut)
 Dim sValue As Long, gValue As Long
 Dim rngC As Range: Set rngC = rngFrom.Offset(1, 1).Resize(rngFrom.Rows.Count - 1, 1)
 Dim m As Integer, nbMonth As Integer, r As Long, nbRow As Integer
 Dim addr As String
 Dim rngMove As Range
 Dim ValueByDate()
 If rngFrom.Columns.Count <> 2 Then MsgBox "2 colonnes requises - Sortie de procédure": Exit Sub
 Application.ScreenUpdating = False
 rngTo.CurrentRegion.Clear
 With Application.WorksheetFunction
  sValue = .Small(rngC, 1): gValue = .Large(rngC, 1)
 End With
 nbMonth = DateDiff("m", sValue, gValue)
 ReDim ValueByDate(nbMonth)
 With rngTo
  .Offset(0, 0) = DateSerial(Year(sValue), Month(sValue), 1)
  For m = 1 To nbMonth
  .Offset(0, m) = DateAdd("m", 1, .Offset(0, m - 1))
  Next
 End With
 With rngFrom
  For r = 1 To .Rows.Count - 1
   m = DateDiff("m", sValue, .Parent.Cells(.Row + r, .Column + 1))
   Set rngMove = rngTo.Parent.Range(rngTo.Offset(0, m).Resize(rngTo.CurrentRegion.Rows.Count, 1).Address)
   nbRow = Application.WorksheetFunction.CountA(rngMove)
   rngTo.Offset(nbRow, m) = .Parent.Cells(.Row + r, .Column) ' Valeur
  Next
 End With
 ' Clear des plages non remplies si EmptyColumn = False
 If Not (EmptyColumn) Then
  For m = nbMonth To 1 Step -1
   Set rngMove = rngTo.Parent.Range(rngTo.Offset(0, m).Resize(rngTo.CurrentRegion.Rows.Count, 1).Address)
   nbRow = Application.WorksheetFunction.CountA(rngMove)
   If nbRow = 1 Then rngMove.Delete Shift:=xlToLeft
  Next
 End If
 Application.ScreenUpdating = False
End Sub