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

GClaire

XLDnaute Occasionnel
Supporter XLD
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
 

Pièces jointes

  • Classeur.xlsm
    390.6 KB · Affichages: 5
Dernière édition:

GClaire

XLDnaute Occasionnel
Supporter XLD
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

XLDnaute Occasionnel
Supporter XLD
CC

Le titrage est OK

VB:
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
 

Discussions similaires

Réponses
7
Affichages
455

Statistiques des forums

Discussions
312 826
Messages
2 092 527
Membres
105 443
dernier inscrit
Raoul