Microsoft 365 Choix et export de données (Résolu)

[GClaire]

Hello la communauté.

Je sollicite une nouvelle fois votre aide pour ce fichier.

Dans ce classeur Excel, je souhaiterai remplir la feuille "Export" a l'aide de la feuille "Base"

La feuille export gardera toujours cette structure.
En remplace simplement les lignes de données, pour :

1) Le Titrage en cellules : (A18, A29, A39, A43, A54, A68 et A79) Sera toujours sur le même format

Ex :
1/6Theme: Nom du Thème = "Numéro en colonne O" & "/6" & 3 sauts de lignes & "Theme:: " & "le Nom du thème en colonne S" (en rapport avec le numéro renseigné Colonne O)

On voit les sauts de lignes dans la cellule en double cliquant dessus.

Il n'y aura jamais deux numéros différents pour un thème et vice et versa, il n'y aura jamais deux thèmes pour 1 numéro.

2) Ensuite récupérer les données des choix fais et les envoyer dans le thème défini :
Plage de A19:H28 : 10 Questions Theme 1
Plage de A30:H39 : 10 Questions Theme 2
Plage de A44:H53 : 10 Questions Theme 3
Plage de A55:H64 : 10 Questions Theme 4
Plage de A69:H78 : 10 Questions Theme 5

Thème 6, rien a toucher, il reste brut de décoffrage, lol.

Les données sont récupérées des colonnes A à H des choix respectif.

J'espère que mes explications seront assez claires

Je vous remercie par avance.

Cordialement, G'Claire

 

[DJunqueira]

Bonjour
dans la colonne H de l'onglet 'base', vous pouvez utiliser la formule suivante:

=SI.MULTIPLE(K5;B5;"A";C5;"B";D5;"C";E5;"D")

 

[GClaire]

Bonjour
dans la colonne H de l'onglet 'base', vous pouvez utiliser la formule suivante:

Merci pour la réponse.

Je ne peux changer la formule de cette colonne car je m'en sers pour ce qu'il se passe avant.

En faite le principe est de remplir la feuille export, car ensuite cette feuille est utilisé sur un soft, en importation de données.

Merci

Bonne soirée.

G'Claire

 

[GClaire]

CC

Le titrage est OK

Option Explicit
Sub RemplirExportManches()
    Dim wsBase As Worksheet
    Dim wsExport As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim countTheme1 As Long, countTheme2 As Long, countTheme3 As Long, countTheme4 As Long, countTheme5 As Long
    
    ' Spécifiez la feuille "Base" et "Export"
    Set wsBase = ThisWorkbook.Sheets("Base")
    Set wsExport = ThisWorkbook.Sheets("Export")
    
    ' Déterminer la dernière ligne de la colonne A dans la feuille "Base"
    lastRow = wsBase.Cells(wsBase.Rows.count, "A").End(xlUp).Row
    
    ' Initialiser le compteur de thèmes
    countTheme1 = 0
    countTheme2 = 0
    countTheme3 = 0
    countTheme4 = 0
    countTheme5 = 0
    
    ' Parcourir la colonne A à partir de la ligne 5
    For i = 5 To lastRow
        Select Case wsBase.Cells(i, 15).Value ' Colonne O
            Case 1
                countTheme1 = countTheme1 + 1
                If countTheme1 <= 10 Then
                    wsExport.Cells(18, 1).Value = "1/6" & vbCrLf & vbCrLf & vbCrLf & "Theme: " & wsBase.Cells(i, 19).Value
                End If
            Case 2
                countTheme2 = countTheme2 + 1
                If countTheme2 <= 10 Then
                    wsExport.Cells(29, 1).Value = "2/6" & vbCrLf & vbCrLf & vbCrLf & "Theme: " & wsBase.Cells(i, 19).Value
                End If
            Case 3
                countTheme3 = countTheme3 + 1
                If countTheme3 <= 10 Then
                    wsExport.Cells(43, 1).Value = "3/6" & vbCrLf & vbCrLf & vbCrLf & "Theme: " & wsBase.Cells(i, 19).Value
                End If
            Case 4
                countTheme4 = countTheme4 + 1
                If countTheme4 <= 10 Then
                    wsExport.Cells(54, 1).Value = "4/6" & vbCrLf & vbCrLf & vbCrLf & "Theme: " & wsBase.Cells(i, 19).Value
                End If
            Case 5
                countTheme5 = countTheme5 + 1
                If countTheme5 <= 10 Then
                    wsExport.Cells(68, 1).Value = "5/6" & vbCrLf & vbCrLf & vbCrLf & "Theme:: " & wsBase.Cells(i, 19).Value
                End If
        End Select
    Next i
    
    ' Vérifier s'il y a moins de 10 choix par nombre
    If countTheme1 < 10 Then MsgBox "Il manque des choix pour le thème 1."
    If countTheme2 < 10 Then MsgBox "Il manque des choix pour le thème 2."
    If countTheme3 < 10 Then MsgBox "Il manque des choix pour le thème 3."
    If countTheme4 < 10 Then MsgBox "Il manque des choix pour le thème 4."
    If countTheme5 < 10 Then MsgBox "Il manque des choix pour le thème 5."
    
    ' Vérifier s'il y a plus de 10 choix sélectionnés
    If countTheme1 > 10 Then MsgBox "Il y a plus de 10 choix sélectionnés pour le thème 1."
    If countTheme2 > 10 Then MsgBox "Il y a plus de 10 choix sélectionnés pour le thème 2."
    If countTheme3 > 10 Then MsgBox "Il y a plus de 10 choix sélectionnés pour le thème 3."
    If countTheme4 > 10 Then MsgBox "Il y a plus de 10 choix sélectionnés pour le thème 4."
    If countTheme5 > 10 Then MsgBox "Il y a plus de 10 choix sélectionnés pour le thème 5."
    
DesactiverRetourAutomatique
    
End Sub

Sub DesactiverRetourAutomatique()
    Dim ws As Worksheet
    Dim rng As Range
    
    ' Spécifie la feuille de calcul "Export"
    Set ws = ThisWorkbook.Sheets("Export")
    
    ' Spécifie les cellules à modifier
    Set rng = ws.Range("A18,A29,A43,A54,A68")
    
    ' Désactive le retour automatique à la ligne
    rng.WrapText = False
End Sub

Je continue, lol

Merci, G'Claire

 

[GClaire]

Hello la communauté

C'est bon problème résolu.

Merci

G'Claire