Discussion :

[jean_baptiste_clem]

Bonjour,

J’ai un tableau de 45 colonnes avec des centaines de lignes. Pour chaque ligne, dans les cellules situées entre la ligne 4 et la ligne 13 incluse, puis entre la ligne 15 et la ligne 24 incluse, on ne compte qu’une seule cellule remplie, toutes les autres sont vides.
Cela tient au fait que chaque ligne de ce tableau est la réponse d’une personne à un questionnaire pour lesquels les répondants ne pouvaient choisir qu’une seule réponse parmi une suite d’options. Par conséquent, le résultat apparaît éclaté entre de nombreuses colonnes.
Je souhaiterais créer une colonne qui regroupe pour chaque ligne la seule cellule remplie qui se situe entre la ligne 4 et la ligne 13 incluse, ou bien entre la ligne 15 et la ligne 24 incluse.
J’ai essayé ça :

Sub RegrouperCellulesRemplies()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long

' Spécifiez ici le nom de votre feuille de calcul
Set ws = ThisWorkbook.Sheets("formulaire 2024 - réponses")

' Déterminer la dernière ligne avec des données dans la colonne A (ajustez selon vos besoins)
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' Parcourir chaque ligne
For i = 1 To lastRow
' Fusionner les valeurs entre la ligne 4 et 13, ou entre la ligne 15 et 24
ws.Cells(i, 46).Value = FusionnerCellulesRemplies(ws.Range(ws.Cells(i, 1), ws.Cells(i, 45)).Offset(0, 3))
Next i
End Sub

Function FusionnerCellulesRemplies(rng As Range) As String
Dim cell As Range
Dim valeurCellule As String

' Parcourir chaque cellule dans la plage spécifiée
For Each cell In rng
' Si la cellule n'est pas vide, enregistrer la valeur et quitter la boucle
If Not IsEmpty(cell.Value) Then
valeurCellule = cell.Value
Exit For
End If
Next cell

' Renvoyer la valeur de la cellule remplie
FusionnerCellulesRemplies = valeurCellule
End Function

en vrai ça ne fonctionne pas du tout, j'ai une erreur 9 ce qui signifie que "l'indice n'appartient pas à la sélection" - qu'il y a un problème avec les indices d'un tableau ou d'une plage qui n'existe pas ou qui est incorrecte.

Mais mon tableau a bien 45 colonnes, et je suis bloqué. Avez-vous une solution ?

[Tête de chat]

Bonjour,

L'erreur est sur quelle ligne ? En lisant rapidement, je pense que la ligne la plus susceptible de donner cette erreur est :

Code :

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

Set ws = ThisWorkbook.Sheets("formulaire 2024 - réponses")

ce qui voudrait dire simplement qu'il y a une faute de frappe dans le nom de lafeuille....

[jean_baptiste_clem]

Bien vu, j'ai enlevé les espaces le tiret du 6 et l'accent du nom de fichier et je n'ai plus cette erreur... mais j'en ai une autre !

erreur de compilation : nom ambigu détecté : FusionnerCellulesRemplies

Je ne vois pas où est l'ambiguité

[Franc]

Salut, si j'ai bien compris tes besoins, voici une macro qui fait le job:

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
Sub RegrouperCellulesRemplies()
    Dim ws As Worksheet
    Dim destRow As Long
    Dim i As Long
    Dim k As Long
 
    ' Spécifie la feuille de calcul
    Set ws = ThisWorkbook.Sheets("formulaire 2024 - réponses")
 
    ' Spécifie la ligne de destination de copie
    destRow = 1
 
    ' Boucle à travers chaque colonne (1 à 45)
    For k = 1 To 45
        ' Boucle à travers chaque plage de lignes (4 à 13, puis 15 à 24)
        For i = 4 To 13
            If Not IsEmpty(ws.Cells(i, k).Value) Then
                ' Si une cellule est remplie, la copie dans la colonne de destination
                ws.Cells(destRow, 46).Value = ws.Cells(i, k).Value
                destRow = destRow + 1
                Exit For
            End If
        Next i
 
        For i = 15 To 24
            If Not IsEmpty(ws.Cells(i, k).Value) Then
                ' Si une cellule est remplie, la copie dans la colonne de destination
                ws.Cells(destRow, 46).Value = ws.Cells(i, k).Value
                destRow = destRow + 1
                Exit For
            End If
        Next i
    Next k
End Sub

[Tête de chat]

Bonjour

nom ambigu détecté : FusionnerCellulesRemplies

Tu as du déclarer deux fois la fonction FusionnerCellulesRemplies