VBA script executé partiellement

Le 06/12/2022 à 19:50

bonjour tout le monde,

dans le script ci-dessous, tout fonctionne sauf la partie For idx = [...] Next idx

fichier de départ ci-joint si nécessaire

J'ai l'impression que le script saute complètement cette partie

Avez-vous une idée ?

D'avance merci 

Option Explicit

Sub ExportSV12CIVA()

Dim DL As Long 'Définition de la variable
Dim idx As Long

DL = Worksheets("liste sv12").Cells(Application.Rows.Count, 1).End(xlUp).Row  'Je définis la dernière ligne dont la colonne A n'est pas vide

Worksheets("export CIVA").Range("A2:A" & DL - 6).Value = "111111111"
Worksheets("export CIVA").Range("B2:B" & DL - 6).Value = "EVV TEST"

Worksheets("liste sv12").Range("C8:C" & DL).Copy
Worksheets("export CIVA").Range("C2").PasteSpecial Paste:=xlPasteValues

Worksheets("liste sv12").Range("A8:A" & DL).Copy
Worksheets("export CIVA").Range("D2").PasteSpecial Paste:=xlPasteValues  'Je copie les lignes de A8 à la dernière ligne

Worksheets("liste sv12").Range("K8:K" & DL).Copy
Worksheets("export CIVA").Range("E2").PasteSpecial Paste:=xlPasteValues

Worksheets("liste sv12").Range("L8:L" & DL).Copy
Worksheets("export CIVA").Range("F2").PasteSpecial Paste:=xlPasteValues

Worksheets("liste sv12").Range("M8:M" & DL).Copy
Worksheets("export CIVA").Range("G2").PasteSpecial Paste:=xlPasteValues

Worksheets("liste sv12").Range("N8:N" & DL).Copy
Worksheets("export CIVA").Range("H2").PasteSpecial Paste:=xlPasteValues

Worksheets("liste sv12").Range("O8:O" & DL).Copy
Worksheets("export CIVA").Range("I2").PasteSpecial Paste:=xlPasteValues

Worksheets("liste sv12").Range("P8:P" & DL).Copy
Worksheets("export CIVA").Range("J2").PasteSpecial Paste:=xlPasteValues

Worksheets("liste sv12").Range("D8:D" & DL).Copy
Worksheets("export CIVA").Range("K2").PasteSpecial Paste:=xlPasteValues

Worksheets("liste sv12").Range("Q8:Q" & DL).Copy
Worksheets("export CIVA").Range("L2").PasteSpecial Paste:=xlPasteValues

Worksheets("liste sv12").Range("R8:R" & DL).Copy
Worksheets("export CIVA").Range("N2").PasteSpecial Paste:=xlPasteValues

Worksheets("liste sv12").Range("S8:S" & DL).Copy
Worksheets("export CIVA").Range("P2").PasteSpecial Paste:=xlPasteValues

Worksheets("export CIVA").Activate

'ajout d'une ligne sous les lignes de crémant, soit Rebêches Rosé soit Blanc selon le cépage

    For idx = Range("E" & Rows.Count).End(xlUp).Row To 1 Step -1
        If Range("E" & idx).Value = "AOC Crémant" And Range("G" & idx).Value = "Pinot Noir Rosé" Then
            Rows(idx).Copy
            Rows(idx + 1).Insert Shift:=xlDown
            Intersect(Rows(idx + 1), Range("J:J")).Value = 0
            Intersect(Rows(idx + 1), Range("G:G")).Value = "Rebêches Rosé"
            Range("P" & idx).Copy Destination:=Range("L" & idx + 1)

            ElseIf Range("E" & idx).Value = "AOC Crémant" Then
            Rows(idx).Copy
            Rows(idx + 1).Insert Shift:=xlDown
            Intersect(Rows(idx + 1), Range("J:J")).Value = 0
            Intersect(Rows(idx + 1), Range("G:G")).Value = "Rebêches Blanc"
            Range("P" & idx).Copy Destination:=Range("L" & idx + 1)

        End If
    Next idx
    'End With    

Dim myRange As Range
Dim Cell As Range
Dim lastRow As Long

lastRow = Worksheets("export CIVA").Cells(Application.Rows.Count, 1).End(xlUp).Row + 1

'je remplace les virgules par des points dans les colonnes de J à O jusqu'a la dernière ligne = variable lastRow

Set myRange = Worksheets("export CIVA").Range("J2:P" & lastRow)
'Set myRange = Worksheets("export CIVA").Range("J2:J" & lastRow) and Worksheets("export CIVA").Range("L2:L" & lastRow)
myRange.NumberFormat = "@"
For Each Cell In myRange
Cell.Value = Replace(Cell.Value, ",", ".")
Next Cell

'je remplis les colonne avec des valeurs fixes et une message box pour les lies
Worksheets("export CIVA").Activate

     Worksheets("export CIVA").Range("A" & lastRow).Value = "111111111"
     Worksheets("export CIVA").Range("B" & lastRow).Value = "EVV TEST"
     Worksheets("export CIVA").Range("E" & lastRow).Value = "LIES"
     Worksheets("export CIVA").Range("L" & lastRow).Value = InputBox("Saisir le volume de Lies", "Lies SV12", 1)
     Worksheets("export CIVA").Columns(16).EntireColumn.Delete

     Application.ScreenUpdating = True
End Sub
11declaration-recolte-export-civa-sv12-forum.xlsm (79.19 Ko)
Le 06/12/2022 à 20:33

Bonjour SantaCruz68

Sans ouvrir le fichier, cela me semble logique vous n'indiquez pas sur quel objet conteneur travailler

Avec le "." point devant le Range() qui rapporte à celui-ci

With Sheets("TOTO")
  For idx = .Range("E" & Rows.Count).End(xlUp).Row To 1 Step -1
....
End With

A+

Le 06/12/2022 à 20:46

Merci BrunoM45,

J'ai apporté cette modification mais toujours pas concluant...

Merci pour ce début de réponse.

Le 06/12/2022 à 20:58

Re,

Qu'est-ce qui ne fonctionne pas exactement... car ça reste vague

A+

Le 07/12/2022 à 08:11

re Bruno,

J'ai fait la correction que tu as proposé :

With Worksheets("export CIVA")
    For idx = .Range("E" & Rows.Count).End(xlUp).Row To 1 Step -1
        If .Range("E" & idx).Value = "AOC Crémant d'Alsace" And Range("G" & idx).Value = "Pinot Noir Rosé" Then
            .Rows(idx).Copy
            .Rows(idx + 1).Insert Shift:=xlDown
            .Intersect(Rows(idx + 1), Range("J:J")).Value = 0
            .Intersect(Rows(idx + 1), Range("G:G")).Value = "Rebêches Rosé"
            .Range("P" & idx).Copy Destination:=Range("L" & idx + 1)

            ElseIf .Range("E" & idx).Value = "AOC Crémant d'Alsace" Then
            .Rows(idx).Copy
            .Rows(idx + 1).Insert Shift:=xlDown
            .Intersect(Rows(idx + 1), Range("J:J")).Value = 0
            .Intersect(Rows(idx + 1), Range("G:G")).Value = "Rebêches Blanc"
            .Range("P" & idx).Copy Destination:=Range("L" & idx + 1)

        End If
    Next idx
    End With

Cependant, j'ai ce message d'erreur

"Erreur d’exécution 438 : propriété ou méthode non gérée par cet objet"

d'après le débogueur, il apparait lorsque le script est sur la fonction .Intersect

je n'arrive pas à solutionner cela

merci

Le 07/12/2022 à 08:22

Bonjour SantaCruz68

Attention, les instructions doivent toutes se rapporter à l'objet conteneur

Exemple :

Intersect(Rows(idx + 1), Range("J:J")).Value = 0

Devrait être

Intersect(.Rows(idx + 1), .Range("J:J")).Value = 0

Ils manques des points un peu partout

A+

Le 07/12/2022 à 09:00

Re Bruno,

Merci pour toutes ces précisions.

ci-dessous mes corrections ; j'ai toujours le message d'erreur.

Je n'arrive pas à trouver d'où provient l'erreur

With Worksheets("export CIVA")
    For idx = .Range("E" & Rows.Count).End(xlUp).Row To 1 Step -1 
        If .Range("E" & idx).Value = "AOC Crémant d'Alsace" And .Range("G" & idx).Value = "Pinot Noir Rosé" Then
            .Rows(idx).Copy
            .Rows(idx + 1).Insert Shift:=xlDown
            .Intersect(.Rows(idx + 1), .Range("J:J")).Value = 0
            .Intersect(.Rows(idx + 1), .Range("G:G")).Value = "Rebêches Rosé"
            .Range("P" & idx).Copy Destination:=.Range("L" & idx + 1)

            ElseIf .Range("E" & idx).Value = "AOC Crémant d'Alsace" Then
            .Rows(idx).Copy
            .Rows(idx + 1).Insert Shift:=xlDown
            .Intersect(.Rows(idx + 1), .Range("J:J")).Value = 0
            .Intersect(.Rows(idx + 1), .Range("G:G")).Value = "Rebêches Blanc"
            .Range("P" & idx).Copy Destination:=.Range("L" & idx + 1)

        End If
    Next idx
    End With
Le 07/12/2022 à 09:16

Re,

Autant pour moi, les yeux pas en face des trous ce matin et les neurones pas encore allumés

Intersect est une instruction pas une propriété ou méthode, donc il ne faut pas de point devant

A+

Le 07/12/2022 à 09:37

YESSSSSSS !

Merci Bruno !

Rechercher des sujets similaires à "vba script execute partiellement"