Microsoft 365 Export données

GClaire · 31 Juillet 2024

Hello la communauté

Dans un fichier pour des quizz (J'avais déjà posé pas mal de demande d'aide).

Le fichier a bien évolué a la demande de mon ami.

Il fonctionne plutôt pas mal et ce grâce a ce forum.

L'export des données fonctionne trés bien, mais je dois faire une modification ou je beug un peu.

Dans ce code (Désolé de la longueur, mais c'était surtout pour avoir tout le déroulé de la procédure) :

VB:

Option Explicit
'----------------------
'- MANCHES MAXI QUIZZ 3-
'----------------------
Sub RemplirExportManchesMaxiQuizz3()
Dim wsBase As Worksheet
Dim wsExport As Worksheet
Dim WS_Donnees As Worksheet
Dim DerLigne As Long
Dim i As Long
Dim rng As Range
Dim NbChoixTheme1 As Long, NbChoixTheme2 As Long, NbChoixTheme3 As Long, NbChoixTheme4 As Long, NbChoixTheme5 As Long, NbChoixTheme6 As Long, NbChoixTheme7 As Long, NbChoixTheme8 As Long ' , NbChoixTheme9 As Long, NbChoixTheme10 As Long
Dim countTheme1 As Long, countTheme2 As Long, countTheme3 As Long, countTheme4 As Long, countTheme5 As Long, countTheme6 As Long, countTheme7 As Long, countTheme8 As Long ', countTheme9 As Long, countTheme10 As Long
Dim CellTheme1 As Long, CellTheme2 As Long, CellTheme3 As Long, CellTheme4 As Long, CellTheme5 As Long, CellTheme6 As Long, CellTheme7 As Long, CellTheme8 As Long ', CellTheme9 As Long, CellTheme10 As Long
Dim CellDepartQuestion1 As Long, CellDepartQuestion2 As Long, CellDepartQuestion3 As Long, CellDepartQuestion4 As Long, CellDepartQuestion5 As Long, CellDepartQuestion6 As Long, CellDepartQuestion7 As Long, CellDepartQuestion8 As Long ', CellDepartQuestion9 As Long, CellDepartQuestion10 As Long
   
'On spécifie la feuille de travail "Base" et "Export (Maxi Quizz3)"
    Set wsBase = ThisWorkbook.Sheets("Choix")
    Set WS_Donnees = ThisWorkbook.Sheets("Listes de Donnees")
    Set wsExport = ThisWorkbook.Sheets("Export (Maxi Quizz3)")
   
' Déterminer la dernière ligne de la colonne A dans la feuille "Base"
    DerLigne = wsBase.Cells(wsBase.Rows.Count, "A").End(xlUp).Row
   
With WS_Donnees
'On défini le nombre de questions
    NbChoixTheme1 = .Range("G3").Value
    NbChoixTheme2 = .Range("G4").Value
    NbChoixTheme3 = .Range("G5").Value
    NbChoixTheme4 = .Range("G6").Value
    NbChoixTheme5 = .Range("G7").Value
    NbChoixTheme6 = .Range("G8").Value
    NbChoixTheme7 = .Range("G9").Value
    NbChoixTheme8 = .Range("G10").Value
'    NbChoixTheme9 = .Range("G11").Value
'    NbChoixTheme10 = .Range("G12").Value

'On défini la cellule ou le theme est indiqué
    CellTheme1 = .Range("N3").Value
    CellTheme2 = .Range("N4").Value
    CellTheme3 = .Range("N5").Value
    CellTheme4 = .Range("N6").Value
    CellTheme5 = .Range("N7").Value
    CellTheme6 = .Range("N8").Value
    CellTheme7 = .Range("N9").Value
    CellTheme8 = .Range("N10").Value
'    CellTheme9 = .Range("N11").Value
'    CellTheme10 = .Range("N12").Value


End With
 
'On Initialise le compteur de thèmes
    countTheme1 = 0
    countTheme2 = 0
    countTheme3 = 0
    countTheme4 = 0
    countTheme5 = 0
    countTheme6 = 0
    countTheme7 = 0
    countTheme8 = 0
    'countTheme9 = 0
    'countTheme10 = 0
   
    ' Parcourir la colonne A à partir de la ligne 5
For i = 5 To DerLigne
    Select Case wsBase.Cells(i, 15).Value ' Colonne O
   
'MANCHE 1 (1-1/3)
        Case 1 'Cellule A16
            countTheme1 = countTheme1 + 1
            If countTheme1 <= NbChoixTheme1 Then
                With wsExport.Cells(CellTheme1, 1)
                    .Value = "Manche 1" _
                        & vbLf & vbLf & vbLf & "1/3" _
                        & vbLf & vbLf & vbLf & "Thème : " & wsBase.Cells(i, 19).Value
                    .WrapText = False
                End With
            End If
           
'MANCHE 2 (1-2/3)
        Case 2 'Cellule A33
            countTheme2 = countTheme2 + 1
            If countTheme2 <= NbChoixTheme2 Then
                With wsExport.Cells(CellTheme2, 1)
                    .Value = "Manche 1" _
                        & vbLf & vbLf & vbLf & "2/3" _
                        & vbLf & vbLf & vbLf & "Thème : " & wsBase.Cells(i, 19).Value
                    .WrapText = False
                End With
            End If
           
'MANCHE 3 (2-1/3)
        Case 3 'Cellule A86
            countTheme3 = countTheme3 + 1
            If countTheme3 <= NbChoixTheme3 Then
                With wsExport.Cells(CellTheme3, 1)
                    .Value = "Manche 2" _
                        & vbLf & vbLf & vbLf & "1/3" _
                        & vbLf & vbLf & vbLf & "Thème : " & wsBase.Cells(i, 19).Value
                    .WrapText = False
                End With
            End If
           
'MANCHE 4 (2-2/3)
        Case 4 'Cellule A110
            countTheme4 = countTheme4 + 1
            If countTheme4 <= NbChoixTheme4 Then
                With wsExport.Cells(CellTheme4, 1)
                    .Value = "Manche 2" _
                        & vbLf & vbLf & vbLf & "2/3" _
                        & vbLf & vbLf & vbLf & "Thème : " & wsBase.Cells(i, 19).Value
                    .WrapText = False
                End With
            End If
           
'MANCHE 5 (2-3/3)
            Case 5 'Cellule A123
            countTheme5 = countTheme5 + 1
            If countTheme5 <= NbChoixTheme5 Then
                With wsExport.Cells(CellTheme5, 1)
                    .Value = "Manche 3" _
                        & vbLf & vbLf & vbLf & "2/3" _
                        & vbLf & vbLf & vbLf & "Thème : " & wsBase.Cells(i, 19).Value
                    .WrapText = False
                End With
            End If
           
'MANCHE 6 (3-2/3)
            Case 6
                countTheme6 = countTheme6 + 1
                If countTheme6 <= NbChoixTheme6 Then
                    With wsExport.Cells(CellTheme6, 1)
                        .Value = "Chamboule tout" _
                        & vbLf & vbLf & vbLf & "Bonus" _
                        & vbLf & vbLf & vbLf & "Thème : " & wsBase.Cells(i, 19).Value
                    .WrapText = False
                End With
                End If
     
'MANCHE 7 (DUELS)
            Case 7
                countTheme7 = countTheme7 + 1
                If countTheme7 <= NbChoixTheme7 Then
                    With wsExport.Cells(CellTheme7, 1)
                        .Value = "10 sec  ABCD" _
                        & vbLf & "Juste de 2000 à 1 point" _
                        & vbLf & "Faux  -1000 à - 1 point" _
                        & vbLf & "Pas de réponse: éliminé !" _
                        & vbLf & "18 survivants !"
                    .WrapText = False
                End With
                End If

'MANCHE 8 (Chamboule tout)
            Case 8
                countTheme8 = countTheme8 + 1
                If countTheme8 <= NbChoixTheme8 Then
                    With wsExport.Cells(CellTheme8, 1)
                        .Value = wsBase.Cells(i, 19).Value _
                           & vbLf & "10 sec  ABCD" _
                           & vbLf & "Juste de 2000 à 1 point" _
                           & vbLf & "Faux  -1000 à - 1 point" _
                           & vbLf & "Pas de réponse: éliminé !" _
                           & vbLf & "18 survivants !"
                        .WrapText = False
                    End With
                End If

'MANCHE 9
'            Case 9
'                countTheme9 = countTheme9 + 1
'                If countTheme9 <= NbChoixTheme9 Then
'                    with wsExport.Cells(CellTheme9, 1)
'                        .Value = wsBase.Cells(i, 19).Value _
'                           & VbLf & "10 sec  ABCD" _
'                           & VbLf & "Juste de 2000 à 1 point" _
'                           & VbLf & "Faux  -1000 à - 1 point" _
'                           & VbLf & "Pas de réponse: éliminé !" _
'                           & VbLf & "18 survivants !"
'                        .WrapText = False
'                    End With
'                End If

'MANCHE 10
'            Case 10
'                countTheme10 = countTheme10 + 1
'                If countTheme10 <= NbChoixTheme10 Then
'                    with wsExport.Cells(CellTheme10, 1)
'                        .Value = wsBase.Cells(i, 19).Value _
'                       & VbLf & "10 sec  ABCD" _
'                       & VbLf & "Juste de 2000 à 1 point" _
'                       & VbLf & "Faux  -1000 à - 1 point" _
'                       & VbLf & "Pas de réponse: éliminé !" _
'                       & VbLf & "18 survivants !"
'                    .WrapText = False
'                End With
'                End If

    End Select
Next i

'On vérifie s'il y a moins de XX choix par Thème
If countTheme1 < NbChoixTheme1 Then MsgBox "Il manque " & NbChoixTheme1 - countTheme1 & " choix pour le thème 1.": Exit Sub
If countTheme2 < NbChoixTheme2 Then MsgBox "Il manque " & NbChoixTheme2 - countTheme2 & " choix pour le thème 2.": Exit Sub
If countTheme3 < NbChoixTheme3 Then MsgBox "Il manque " & NbChoixTheme3 - countTheme3 & " choix pour le thème 3.": Exit Sub
If countTheme4 < NbChoixTheme4 Then MsgBox "Il manque " & NbChoixTheme4 - countTheme4 & " choix pour le thème 4.": Exit Sub
If countTheme5 < NbChoixTheme5 Then MsgBox "Il manque " & NbChoixTheme5 - countTheme5 & " choix pour le thème 5.": Exit Sub
If countTheme6 < NbChoixTheme6 Then MsgBox "Il manque " & NbChoixTheme6 - countTheme6 & " choix pour le thème 6.": Exit Sub
If countTheme7 < NbChoixTheme7 Then MsgBox "Il manque " & NbChoixTheme7 - countTheme7 & " choix pour le thème 7.": Exit Sub
If countTheme8 < NbChoixTheme8 Then MsgBox "Il manque " & NbChoixTheme8 - countTheme8 & " choix pour le thème 8.": Exit Sub
'If countTheme9 < NbChoixTheme9 Then MsgBox "Il manque " & NbChoixTheme9 - countTheme9 & " choix pour le thème 9.": Exit Sub
'If countTheme10 < NbChoixTheme10 Then MsgBox "Il manque " & NbChoixTheme10 - countTheme10 & " choix pour le thème 10.": Exit Sub

'On vérifie s'il y a plus de XX choix sélectionnés par Thème
If countTheme1 > NbChoixTheme1 Then MsgBox "Il y a " & countTheme1 - NbChoixTheme1 & " choix de trop sélectionnés pour le thème 1.": Exit Sub
If countTheme2 > NbChoixTheme2 Then MsgBox "Il y a " & countTheme2 - NbChoixTheme2 & " choix de trop sélectionnés pour le thème 2.": Exit Sub
If countTheme3 > NbChoixTheme3 Then MsgBox "Il y a " & countTheme3 - NbChoixTheme3 & " choix de trop sélectionnés pour le thème 3.": Exit Sub
If countTheme4 > NbChoixTheme4 Then MsgBox "Il y a " & countTheme4 - NbChoixTheme4 & " choix de trop sélectionnés pour le thème 4.": Exit Sub
If countTheme5 > NbChoixTheme5 Then MsgBox "Il y a " & countTheme5 - NbChoixTheme5 & " choix de trop sélectionnés pour le thème 5.": Exit Sub
If countTheme6 > NbChoixTheme6 Then MsgBox "Il y a " & countTheme6 - NbChoixTheme6 & " choix de trop sélectionnés pour le thème 6.": Exit Sub
If countTheme7 > NbChoixTheme7 Then MsgBox "Il y a " & countTheme7 - NbChoixTheme7 & " choix de trop sélectionnés pour le thème 7.": Exit Sub
If countTheme8 > NbChoixTheme8 Then MsgBox "Il y a " & countTheme8 - NbChoixTheme8 & " choix de trop sélectionnés pour le thème 8.": Exit Sub
'If countTheme9 > NbChoixTheme9 Then MsgBox "Il y a " & countTheme9 - NbChoixTheme9 & " choix de trop sélectionnés pour le thème 9.": Exit Sub
'If countTheme10 > NbChoixTheme10 Then MsgBox "Il y a " & countTheme10 - NbChoixTheme10 & " choix de trop sélectionnés pour le thème 10.": Exit Sub

ExportDataMaxiQuizz3
   
End Sub

'------------------------------------------------------
'- J'exporte les données vers leur manches Maxi Quizz -
'------------------------------------------------------
Sub ExportDataMaxiQuizz3()

Dim baseSheet As Worksheet
Dim exportSheet As Worksheet
Dim WS_Donnees As Worksheet
Dim DerLigne As Long
Dim i As Long, j As Long, k As Long
Dim exportRow As Long, exportRowReponse As Long, exportReponse As Long, exportRowChoix As Long
Dim CellDepartQuestion1 As Long, CellDepartQuestion2 As Long, CellDepartQuestion3 As Long, CellDepartQuestion4 As Long, CellDepartQuestion5 As Long, CellDepartQuestion6 As Long, CellDepartQuestion7 As Long, CellDepartQuestion8 As Long ', CellDepartQuestion9 As Long, CellDepartQuestion10 As Long

' Spécifier les feuilles de calcul
Set baseSheet = ThisWorkbook.Sheets("Choix")
Set exportSheet = ThisWorkbook.Sheets("Export (Maxi Quizz3)")
Set WS_Donnees = ThisWorkbook.Sheets("Listes de Donnees")

With WS_Donnees
'On défini la cellule de départ des quetsions
    CellDepartQuestion1 = .Range("O3").Value
    CellDepartQuestion2 = .Range("O4").Value
    CellDepartQuestion3 = .Range("O5").Value
    CellDepartQuestion4 = .Range("O6").Value
    CellDepartQuestion5 = .Range("O7").Value
    CellDepartQuestion6 = .Range("O8").Value
    CellDepartQuestion7 = .Range("O9").Value
    CellDepartQuestion8 = .Range("O10").Value
'    CellDepartQuestion9 = .Range("O11").Value
'    CellDepartQuestion10 = .Range("O12").Value
End With

' Trouver la dernière ligne dans la colonne O de la feuille "Base"
DerLigne = baseSheet.Cells(baseSheet.Rows.Count, "O").End(xlUp).Row

' Initialiser la ligne de départ dans la feuille "Export (Maxi Quizz3)"

'Theme 1 (1-1/3)
exportRow = CellDepartQuestion1 'En A18

' Parcourir les valeurs dans la colonne O à partir de la ligne 5
For i = 5 To DerLigne
    If baseSheet.Cells(i, "O").Value = 1 Then
        ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz3)"
        For j = 1 To 8
            exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
                     
        Next j
        exportRow = exportRow + 1
    End If
Next i

'Theme 2 (1-2/3)
exportRow = CellDepartQuestion2 'En A37

For i = 5 To DerLigne
    If baseSheet.Cells(i, "O").Value = 2 Then
        ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz3)"
        For j = 1 To 8
            exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
        Next j
        exportRow = exportRow + 2
    End If
Next i


'Theme 3 (2-1/3)
exportRow = CellDepartQuestion3 'En A89 ++++++ COMPLIQUE QUESTION DECALEE
exportRowChoix = CellDepartQuestion3 - 1
exportRowReponse = CellDepartQuestion3

For i = 5 To DerLigne
    If baseSheet.Cells(i, "O").Value = 3 Then
        ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz3)"
        For j = 1 To 1
            'exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
            exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
        Next j
        exportRow = exportRow + 2
       

        For j = 2 To 7
            exportSheet.Cells(exportRowChoix, j).Value = baseSheet.Cells(i, j).Value
        Next j
        exportRowChoix = exportRowChoix + 2
       

        For j = 8 To 8
            exportSheet.Cells(exportRowReponse, j).Value = baseSheet.Cells(i, j).Value
        Next j
        exportRowReponse = exportRowReponse + 2
    End If

Next i


'Theme 4 (2-2/3)
exportRow = CellDepartQuestion4 'En A112

For i = 5 To DerLigne
    If baseSheet.Cells(i, "O").Value = 4 Then
        ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz3)"
        For j = 1 To 8
            exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
        Next j
        exportRow = exportRow + 1
    End If
Next i

'Theme 5 (2-3/3)-ENIGME DU FORT
exportRow = CellDepartQuestion5 'En A126
exportReponse = CellDepartQuestion5 + 1

For i = 5 To DerLigne
    If baseSheet.Cells(i, "O").Value = 5 Then
        ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz3)"
        For j = 1 To 1
            exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
        Next j
       
        For j = 8 To 8
            exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
        Next j
        exportRow = exportRow + 2
   
'J'exporte la réponse en dessous de la question
        For j = 2 To 2
            exportSheet.Cells(exportReponse, j).Value = "La vrai réponse et : " & baseSheet.Cells(i, j).Value
        Next j
        exportReponse = exportReponse + 2
    End If
Next i


'Theme 6 (3-2/3)
exportRow = CellDepartQuestion6 'En A64

For i = 5 To DerLigne
    If baseSheet.Cells(i, "O").Value = 6 Then
        ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz3)"
        For j = 1 To 8
            exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
        Next j
        exportRow = exportRow + 1
    End If
Next i

'Theme 7 (DUEL)
exportRow = CellDepartQuestion7 'En A212

For i = 5 To DerLigne
    If baseSheet.Cells(i, "O").Value = 7 Then
        ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz3)"
        For j = 1 To 8
            exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
        Next j
        exportRow = exportRow + 3 'On décale de 3
    End If
Next i

'Theme 8 (Chamboule tout)
exportRow = CellDepartQuestion8 'En A212

For i = 5 To DerLigne
    If baseSheet.Cells(i, "O").Value = 8 Then
        ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz3)"
        For j = 1 To 8
            exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
        Next j
        exportRow = exportRow + 2 'On décale de 2
    End If
Next i

''Theme 9
'exportRow = CellDepartQuestion9 'En A212
'
'For i = 5 To DerLigne
'    If baseSheet.Cells(i, "O").Value = 9 Then
'        ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz3)"
'        For j = 1 To 8
'            exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
'        Next j
'        exportRow = exportRow + 3 'On décale de 3
'    End If
'Next i
'
''Theme 10
'exportRow = CellDepartQuestion10 'En A212
'
'For i = 5 To DerLigne
'    If baseSheet.Cells(i, "O").Value = 10 Then
'        ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz3)"
'        For j = 1 To 8
'            exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
'        Next j
'        exportRow = exportRow + 3 'On décale de 3
'    End If
'Next i


MsgBox "Les manches du Maxi Quizz 3 ont bien été créées", vbInformation

'On vide les variables
Set baseSheet = Nothing
Set exportSheet = Nothing
Set WS_Donnees = Nothing
'ExportMaxiQuizz

End Sub

Dans la partie :

Code:

'Theme 5 (2-3/3)-ENIGME DU FORT
exportRow = CellDepartQuestion5 'En A126
exportReponse = CellDepartQuestion5 + 1

For i = 5 To DerLigne
    If baseSheet.Cells(i, "O").Value = 5 Then
        ' Copier les valeurs de la plage A:A dans la feuille "Export (Maxi Quizz3)"
        For j = 1 To 1
            exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
        Next j
' Copier les valeurs de la plage H:H dans la feuille "Export (Maxi Quizz3)"       
        For j = 8 To 8
            exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
        Next j
        exportRow = exportRow + 2
   
'J'exporte la réponse en dessous de la question
        For j = 2 To 2
            exportSheet.Cells(exportReponse, j).Value = "La vrai réponse et : " & baseSheet.Cells(i, j).Value
        Next j
        exportReponse = exportReponse + 2
    End If
Next i

Jusqu'à présent j'exporté les données en ligne, et pour ce bout d'export, je dois pouvoir exporter 2 des données sur la même ligne (La question et La bonne réponse, ça c'est OK), mais pouvoir, mettre en dessous la donnée de la colonne 2 (La réponse avec ce texte :" La bonne réponse est : " & le resultat, ce que j'essaye de faire avec ce bout de code,

Code:

'J'exporte la réponse en dessous de la question

        For j = 2 To 2

            exportSheet.Cells(exportReponse, j).Value = "La bonne réponse est : " & baseSheet.Cells(i, j).Value

        Next j

        exportReponse = exportReponse + 2

    End If

Next i

Cela le met bien en dessous comme prévue, en revance il se positionne en colonne "B" au lieu de la colonne "A", normale c'était prévue comme cela.

Comme je pourrais faire cela?

Si besoin je peux mettre les feuilles de classeur nécessaires pour mieux visualiser cela.

Merci très, très beaucoup.

Passez une bonne journée.

G'Claire

wDog66 · 31 Juillet 2024

Bonjour GClaire

Dans le code ci-dessous, exportReponse représente la ligne et ... le "j" représente la colonne

VB:

exportSheet.Cells(exportReponse, j).Value

Donc si vous faites une boucle qui est totalement inutile comme

Code:

For j = 2 To 2

Pour chaque colonne de 2 à 2

Il suffit de mettre 1 dans votre ligne

Bonne journée

dysorthographie · 31 Juillet 2024

Bonjour,
J'ai jamais compris pourquoi nous devions toujours hotopsier le code existant avant de répondre à une question.

Je ne vais pas me lancer dans cette opération. Que fait cette macro et pourquoi cette gabji de variables ?

GClaire · 31 Juillet 2024

dysorthographie à dit:
Bonjour,
J'ai jamais compris pourquoi nous devions toujours hotopsier le code existant avant de répondre à une question.

Je ne vais pas me lancer dans cette opération. Que fait cette macro et pourquoi cette gabji de variables ?

Non pas Hotopsier, il y avait juste un bout de code, mais j'avais mis la procédure complète si des choses n'étaient pas comprise avec juste le petit bout de code.

Et j'ai bien indiqué, que s'il fallait un bout de classeur, je le mettrai.

Je pense que des fois, juste le code, est quand même moins lourds a supporter pour le forum, qu'un fichier.

Cette gabbi de variable, me sert a aller chercher des infos dans une feuille (NB de question (Pour des test de manière a cocher la bonne quantité dans la feuille "Base", cellule du texte du thème, cellule de départ des questions, etc...), que je peux modifier, sans être obliger de modifier le code.

Je pense qu'il aurait etait possible de faire plus simple, mais je ne sui spas dévellopeur VBA, je me bat, mais j'essaye de faire au mieux.

La preuve, mon erreur de boucle, la ou il n'en faut pas, lol.

Bonne soirée.

G'Claire

GClaire · 31 Juillet 2024

wDog66 à dit:
Bonjour GClaire

Dans le code ci-dessous, exportReponse représente la ligne et ... le "j" représente la colonne

VB:

exportSheet.Cells(exportReponse, j).Value

Donc si vous faites une boucle qui est totalement inutile comme

Code:

For j = 2 To 2

Pour chaque colonne de 2 à 2

Il suffit de mettre 1 dans votre ligne

Bonne journée

wDog66, le forum

Merci pour la réponse et la piqure de rappel pour mes boucles qui ne servent a rien (Des copier/Coller et modification sans réfléchir).

Voici le code, modifié :

VB:

For i = 5 To DerLigne
    If baseSheet.Cells(i, "O").Value = 5 Then
        ' Copier les valeurs de la plage A:H dans la feuille "Export (Maxi Quizz3)"
'        For j = 1 To 1
'            exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
'        Next j
            exportSheet.Cells(exportRow, 1).Value = "- " & NumQuestion & " -" & baseSheet.Cells(i, 1).Value
       
'        For j = 8 To 8
'            exportSheet.Cells(exportRow, j).Value = baseSheet.Cells(i, j).Value
'        Next j
            exportSheet.Cells(exportRow, 8).Value = baseSheet.Cells(i, 8).Value
       
        exportRow = exportRow + 2
   
'J'exporte la réponse en dessous de la question
'        For j = 2 To 2
'            exportSheet.Cells(exportReponse, j).Value = "La vrai réponse et : " & baseSheet.Cells(i, j).Value
'        Next j
            exportSheet.Cells(exportReponse, 1).Value = "La bonne réponse est :" & vbLf & baseSheet.Cells(i, 2).Value
     
        exportReponse = exportReponse + 2
        NumQuestion = NumQuestion + 1
    End If
Next i

Pour les tests, j'ai laissé en commentaire l'ancien code, mais je virerai tout cela.

J'en ai profité pour faire un ti ménage dans la procédure complète afin de supprimer toutes ces boucles inutiles.

Merci encore.

Bonne soirée.

G'Claire

Effectuez une recherche sur Excel Downloads...

Microsoft 365 Export données

GClaire

XLDnaute Occasionnel

wDog66

XLDnaute Occasionnel

dysorthographie

XLDnaute Accro

GClaire

XLDnaute Occasionnel

GClaire

XLDnaute Occasionnel

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums