Discussion :

[Oluapoten]

Bonjour à tous,
Je cherche comment parcourir un tableau colonne par colonne, puis ligne par ligne, et à chaque fois que je trouve une cellule non vide, je veux recopier son contenu ainsi que celui de la cellule qui suit vers second tableau. J'ai lu et testé les tuto sur le sujet, mais étant néophyte, je suis un peu perdu.
Je réussi a obtenir le premier tableau par une adaptation de différentes macros, mais du coup, certaines plages sont vides. Je dois donc le transposer dans un planning de matchs sachant que j'ai six terrains.
Dés que mes six terrains sont occupés pour le premier horaire, je colle les matches suivants sur l'horaire qui suit et ainsi de suite.
Je joins le fichier, j'espère que ce sera plus clair.
Merci d'avance pour votre aide.

[Thautheme]

Bonsoir Oluapoten, bonsoir le forum,

En pièce jointe ton fichier modifié avec le code ci-dessous :

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
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim LI As Byte 'déclare la variable LI (LIgne)
Dim COL As Byte 'déclare la variable COL (COLonne)
Dim LID As Byte 'déclare la variable LID (LIgne Destination))
Dim COD As Byte 'déclare la variable COD (COlonne Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
 
Application.ScreenUpdating = fale 'masque les rafraîchissements d'écran
Set O = Sheets("HORAIRES") 'définit l'onglet O
For LI = 9 To 23 'boucle 1 : sur toutes les lignes LI de 9 à 23
    For COL = 29 To 44 Step 2 'boucle 2 : sur toutes les colonnes COL de 29 à 44 (= AC à AR) par pas de deux
        If O.Cells(LI, COL) <> "" Then 'condition 1 : si la cellule ligne LI colonne COL n'est pas vide
            If Range("C3").Value = "" Then 'condition 2 : si la cellule C3 est vide
                Set DEST = O.Range("C3") 'définit la cellule de destination DEST (=C3)
            Else 'sinon (condition 2, si la cellue C3 n'est pas vide)
                'condition 3 : si le nombre de cellules vides des 12 cellules (colonne C à N)
                'de la dernière ligne éditée en colonne C est inférieur à 12
                If Application.WorksheetFunction.CountA(O.Cells(Application.Rows.Count, 3).End(xlUp).Resize(1, 12)) < 12 Then
                    'définit la ligne de destination LID (dernière ligne éditée de la colonne 3=C)
                    LID = O.Cells(Application.Rows.Count, 3).End(xlUp).Row
                    'définit la colonne de destination COD (dernière colonne éditée de la ligne LID plus une)
                    COD = O.Cells(LID, 1).End(xlToRight).Column + 1
                    Set DEST = O.Cells(LID, COD) 'définit la cellule de destination DEST
                Else 'sinon (condition 3, si le nombre est égal à 12)
                    'définit la cellule de destination DEST (première ligne vide de la colonne 3=C)
                    Set DEST = O.Cells(Application.Rows.Count, 3).End(xlUp).Offset(1, 0)
                End If 'fin de la condition 3
            End If 'fin de la condition 2
            O.Cells(LI, COL).Resize(1, 2).Copy DEST 'copie la paire du match et la colle dans DEST
        End If 'fin de la condition 1
    Next COL 'prochaine colonne de la boucle 2
Next LI 'prochaine ligne de la boucle 1
Application.ScreenUpdating = fale 'affiche les rafraîchissements d'écran
End Sub

Clique sur le bouton Matchs...

[Oluapoten]

Whouaou!
C'est exactement ce que je recherchais.
Merci beaucoup Thautheme .