Bonjour à tous,

Je le précise même si vous allez le voir par vous meme, mais je suis novice en langage de programmation

Je suis en train d'essayer de coder une macro qui me permettra de remplir une feuille excel avec template prédéfini avec des données d'une autre feuille.

Pour cela j'utilise une boucle For each et je veux incrémenter un range selon trois conditions.

 Je rencontre cependant un probleme une fois rentré dans une condition sur la définition de mon range et les valeurs à remplir. J'ai essayé plein de variantes dans ce code mais sans succès...  

Private Sub test()

Dim row As ListRow
Dim sCatalog, sType, sPrice As String
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Catalog Template")
Dim rPN As Range: Set rPN = ws.Cells(9, 2)
Dim rDesc As Range: Set rDesc = ws.Cells(11, 2)
Dim rDr As Range: Set rDr = ws.Cells(15, 5)
Dim rCat As Range: Set rCat = ws.Cells(15, 8)


Application.ScreenUpdating = False

J = 0

For Each row In ActiveSheet.ListObjects("SpareList").ListRows

    sCatalog = "Mainframe"
    sType = "Spare"

    'sCatalog = ComboBox2.Value
    'sType = ComboBox3.Value
    'sPrice = ComboBox4.Value
    
    'test1 = row.Range(1, 1).Value
    'test2 = row.Range(1, 2).Value
    'test3 = row.Range(1, 9).Value
    'test4 = row.Range(1, 8).Value
    
    If row.Range(1, 13) = sCatalog Or row.Range(1, 14) = sCatalog Or row.Range(1, 15) = sCatalog Or row.Range(1, 16) = sCatalog Or row.Range(1, 17) = sCatalog Or row.Range(1, 18) = sCatalog Or row.Range(1, 19) = sCatalog Or row.Range(1, 20) = sCatalog Or row.Range(1, 21) = sCatalog Or row.Range(1, 12) = sCatalog Then
        
        If row.Range(1, 6) = sType Then
            
            If J = 0 Then
            
                rPN.Value = row.Range(1, 1).Value
                rDesc.Value = row.Range(1, 2).Value
                rDr.Value = row.Range(1, 9).Value
                rCat.Value = row.Range(1, 8).Value
            
            Else:
                
                If J Mod 2 <> 0 Then
                
                    Set rPN = rPN.Offset(0, 8)
                    Set rDesc = rDesc.Offset(0, 8)
                    Set rDr = rDr.Offset(0, 8)
                    Set rCat = rCat.Offset(0, 8)
                
                    rPN.Value = row.Range(1, 1).Value
                    rDesc.Value = row.Range(1, 2).Value
                    rDr.Value = row.Range(1, 9).Value
                    rCat.Value = row.Range(1, 8).Value
                    
                Else:
                
                    Set rPN = rPN.Offset(9, -8)
                    Set rDesc = rDesc.Offset(9, -8)
                    Set rDr = rDr.Offset(9, -8)
                    Set rCat = rCat.Offset(9, -8)
                                        
                    rPN.Value = row.Range(1, 1).Value
                    rDesc.Value = row.Range(1, 2).Value
                    rDr.Value = row.Range(1, 9).Value
                    rCat.Value = row.Range(1, 8).Value
                
                End If
            
            End If

            J = J + 1
            
        End If
        
    End If
    
Next row

Application.ScreenUpdating = True


End Sub

Pouvez-vous m'aider sur l'ecriture de ce code car je sèche completement.

Je vous remercie pour le temps que vous m'accorderez.

Cdt,

Cervoise

A mon avis, ton problème vient du fait que tu changes la définition des ranges rPN, rDesc, rDr, rCat aux ligne 46-49 et 58-61. 

A partir du moment où tu les as modifié, il garde leur valeurs d'un tour de boucle à l'autre.

Tu peux rajouter les offsets directement sur les lignes où tu changes les valeurs

...
            Else:
                 
                If J Mod 2 <> 0 Then
                 
                    rPN.Offset(0, 8).Value = row.Range(1, 1).Value
                    rDesc.Offset(0, 8).Value = row.Range(1, 2).Value
                    rDr.Offset(0, 8).Value = row.Range(1, 9).Value
                    rCat.Offset(0, 8).Value = row.Range(1, 8).Value
                     
                Else:
                                        
                    rPN.Offset(9, -8).Value = row.Range(1, 1).Value
                    rDesc.Offset(9, -8).Value = row.Range(1, 2).Value
                    rDr.Offset(9, -8).Value = row.Range(1, 9).Value
                    rCat.Offset(9, -8).Value = row.Range(1, 8).Value
                 
                End If
             
            End If
...

Et il doit aussi te manquer quelque part l'utilisation du J dans les offsets.

Il faudrait que tu précises ce que tu obtiens et ce tu veux obtenir parce là on ne peut qu'émettre des hypothèses.

Bonjour umfred,

Merci pour ta réponse et je viens tout juste de comprendre mon probleme, et je suis sur que tu vas comprendre également en te joignant le template que j'essaie de remplir

Le probleme venait donc de mes offset et des cellules fusionnées.

En effet avec les offset quotés précédemment les valeurs retournées étaient vides car non définies, avec les nouveaux offsets comme ci-dessous cela fonctionne :

Dim row As ListRow
Dim sCatalog, sType, sPrice As String
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Sheets("Catalog Template")
Dim rPN As Range: Set rPN = ws.Range("B10")
Dim rDesc As Range: Set rDesc = ws.Range("B12")
Dim rDr As Range: Set rDr = ws.Range("E16")
Dim rCat As Range: Set rCat = ws.Range("H16")

Application.ScreenUpdating = False

J = 0

For Each row In ActiveSheet.ListObjects("SpareList").ListRows

    sCatalog = "Mainframe"
    sType = "Spare"

    'sCatalog = ComboBox2.Value
    'sType = ComboBox3.Value
    'sPrice = ComboBox4.Value
    
    If row.Range(1, 13) = sCatalog Or row.Range(1, 14) = sCatalog Or row.Range(1, 15) = sCatalog Or row.Range(1, 16) = sCatalog Or row.Range(1, 17) = sCatalog Or row.Range(1, 18) = sCatalog Or row.Range(1, 19) = sCatalog Or row.Range(1, 20) = sCatalog Or row.Range(1, 21) = sCatalog Or row.Range(1, 12) = sCatalog Then
        
        
        If row.Range(1, 6) = sType Then
            
            If J = 0 Then
            
                rPN.Value = row.Range(1, 1).Value
                rDesc.Value = row.Range(1, 2).Value
                rDr.Value = row.Range(1, 9).Value
                rCat.Value = row.Range(1, 8).Value
            
            Else:
                
                If J Mod 2 <> 0 Then
                
                    Set rPN = rPN.Offset(0, 8)
                    Set rDesc = rDesc.Offset(0, 8)
                    Set rDr = rDr.Offset(0, 13)
                    Set rCat = rCat.Offset(0, 8)
                    
                    rPN.Value = row.Range(1, 1).Value
                    rDesc.Value = row.Range(1, 2).Value
                    rDr.Value = row.Range(1, 9).Value
                    rCat.Value = row.Range(1, 8).Value
                
                    
                Else:
                
                    Set rPN = rPN.Offset(9, -13)
                    Set rDesc = rDesc.Offset(6, -13)
                    Set rDr = rDr.Offset(9, -13)
                    Set rCat = rCat.Offset(9, -13)
                    
                    rPN.Value = row.Range(1, 1).Value
                    rDesc.Value = row.Range(1, 2).Value
                    rDr.Value = row.Range(1, 9).Value
                    rCat.Value = row.Range(1, 8).Value
                
                End If
            
            End If

            J = J + 1
            
        End If
        
    End If
            
    'Rows.Hidden = False
    'Else:
    'row.Range(1, 13).EntireRow.Hidden = False
    'Else:
    'row.Range(1, 13).EntireRow.Select
    'row.Range(1, 13).EntireRow.Hidden = True
    'End If
    'End If
    
Next row

Application.ScreenUpdating = True

End Sub

Bon par contre j'ai un joli "OUT OF MEMORY" à la fin de l'execution de cette macro... Aurais-tu une idée ?

Merci et bonne journe.

Cdt,

Cervoise

a priori je ne vois pas l'image (il faut éviter le copier-coller d'image pour insérer une image ici).
Donc tu ne pointais pas sur les bonnes cellules au début de la fonction si je comprends bien (Cells pour le Range se base sur des indices à partir de 1 (Cells(1,1) = "A1").

Pour le out of memory, pas forcément d'idée là, il faudrait voir sur quelle ligne ça arrive.

Il se peut que tu utilises une version 32 bits d'office et tu essais d'indexer quelque chose hors des limites possibles, ou qu'un processus occupe trop de mémoire de ton PC.