Variable objet ou variable bloc With non définie

Le 13/08/2023 à 12:47

Bonjour à tous,

je suis débutant sur VBA, j'essaie de créer une macro VBA qui me permet d'aller chercher une donnée sur un autre fichier Excel , à travers les références des celluleoù il devra chercher, ça fnctionnre bien pour la première référence, sur la deuxième boucle il m'affiche (Variable objet ou variable bloc With non définie),

voici le code que j'utilise ;

Sub test()

    Set WbBase = Workbooks(Range("O2").Value & ".xlsm")
    Set ShBase = WbBase.Sheets("MAIN Questionnaire")
    Set WbFichier2 = Workbooks("Classeur1.xlsm") 
    Set ShFichier2 = WbFichier2.Sheets("Synt")
    nbcells = Application.WorksheetFunction.CountA(Worksheets("Synt").Range("$A:$A")) - 1

    For i = 2 To nbcells
        For c = 13 To 14
        With ShBase
             Set CelluleReference = ShBase.Cells(Cells(i, 12).Value, Cells(i, c).Value)
             'Set CelluleReference = ShBase.Cells(Range("L2").Value, Range("M2").Value)
        End With

            With ShFichier2
             .Cells(i, c + 3) = CelluleReference
        End With

        Set WbFichier2 = Nothing
        Set ShFichier2 = Nothing
        Set CelluleReference = Nothing
        Set ShBase = Nothing
        Set WbBase = Nothing
        Next c
    Next i

End Sub

Merci beaucoup pour votre aide.

Le 13/08/2023 à 15:00

Bonjour et bienvenu sur le site

Logique

Dans ta boucle tu srpptime la valeur des valiables...

Met un ' devant les lignes suivantes...

       Set WbFichier2 = Nothing
        Set ShFichier2 = Nothing
        Set CelluleReference = Nothing
        Set ShBase = Nothing
        Set WbBase = Nothing

A+ François

Le 13/08/2023 à 15:23

bonjour FanFan38, et merci beaucoup pour ton aide,

j'ai réajusté suivant ta recomandation, et j'ai continuer à coder (comme je peux :)), et j'ai un nouveau message d'erreur, (Erreur définie par l'application ou par l'objet)

voici mon code:

le débug renvoi sur la ligne (CelluleReference);

Sub test()

Dim CheminComplet As String
Dim a As String
    a = Workbooks("Classeur1.xlsm").Worksheets("Synt").Range("O2").Value
    CheminComplet = "D:\Bureau\TRVX_QA\2023\08- QA_Aout_23\Sprint1\Retour AQ\"
    nbcells = Workbooks("Classeur1.xlsm").Worksheets("Synt").Range("A2", Selection.End(xlDown)).Cells.Count
    Set WbBase = Workbooks.Open(Filename:=CheminComplet & Range("O2").Value & ".xlsm")
    Set ShBase = WbBase.Worksheets("MAIN Questionnaire QA FR")
    Set WbFichier2 = Workbooks("Classeur1.xlsm")
    Set ShFichier2 = WbFichier2.Sheets("Synt")

    'Do While a <> ""
        For i = 2 To nbcells
            For c = 13 To 14
            With ShBase
                 CelluleReference = Workbooks(a & ".xlsm").Worksheets("MAIN Questionnaire QA FR").Cells(Cells(i, 12).Value, Cells(i, c).Value)
            End With

                With ShFichier2
                 Workbooks("Classeur1.xlsm").Worksheets("Synt").Cells(i, c + 3) = CelluleReference
            End With

            'Set WbFichier2 = Nothing
            'Set ShFichier2 = Nothing
            'Set CelluleReference = Nothing
            'Set ShBase = Nothing
            'Set WbBase = Nothing
            Workbooks(a & ".xlsm").Close SaveChanges:=False
            Next c
        Next i
    'Loop
End Sub

merci beaucoupe pour votre aide;

Le 13/08/2023 à 15:35

Ce serait tellement plus simple (et plus sûr) si on avait un fichier...

a est egal à: a = Workbooks("Classeur1.xlsm").Worksheets("Synt").Range("O2").Value

et cellule référence

CelluleReference = Workbooks(a & ".xlsm").Worksheets("MAIN Questionnaire QA FR").Cells(Cells(i, 12).Value, Cells(i, c).Value)

A+ François

Le 13/08/2023 à 16:24

bonjour à tous,

essaie ceci

With Workbooks(a & ".xlsm").Worksheets("MAIN Questionnaire QA FR") 
   CelluleReference = .Range(.Cells(i, 12).Value, .Cells(i, c).Value)
End With
Le 13/08/2023 à 16:29

Bonjour Francois,

Tu as raison, je te joins les deux fichiers, "source" (où figure la donnée à récupérer), et le fichier "Classeur2" où je veux récupérer ma valeur.

En pratique, je suis sensé récupérer le valeur du champ "A1" du fichier (source), et la coller sur le champ "E1" du fichier (Classeur2).

et boucler cette reprise sur les deux lignes du fichier (Classeur2).

1000 Merci pour ton aide.

Je te joins les deux fichiers ainsi que le code que je n'arrive pas à faire marcher.

Sub test()
Dim CheminComplet As String
Dim a As String
    a = Workbooks("Classeur2.xlsm").Worksheets("Synt").Range("D2").Value
    CheminComplet = "D:\Bureau\TRVX_QA\2023\08- QA_Aout_23\Sprint1\Retour AQ\"
    nbcells = Workbooks("Classeur2.xlsm").Worksheets("Synt").Range("A2", Selection.End(xlDown)).Cells.Count
    Set WbBase = Workbooks.Open(Filename:=CheminComplet & Range("D2").Value & ".xlsm")
    Set ShBase = WbBase.Worksheets("Synt")
    Set WbFichier2 = Workbooks("source.xlsm")
    Set ShFichier2 = WbFichier2.Sheets("MAIN Questionnaire QA FR")

    Do While a <> ""
        For i = 1 To nbcells
            For c = 1 To 2
            With ShBase
                 CelluleReference = Workbooks(a & ".xlsm").Worksheets("MAIN Questionnaire QA FR").Cells(Cells(i, 1).Value, Cells(i, c).Value)
            End With
            With ShFichier2
                 Workbooks("Classeur1.xlsm").Worksheets("Synt").Cells(i, c + 3) = CelluleReference
            End With

            'Set WbFichier2 = Nothing
            'Set ShFichier2 = Nothing
            'Set CelluleReference = Nothing
            'Set ShBase = Nothing
            'Set WbBase = Nothing
            'Workbooks(a & ".xlsm").Close SaveChanges:=False
            Next c
        Next i
    Loop
End Sub
7source.xlsm (8.45 Ko)
9classeur2.xlsm (15.47 Ko)
Le 13/08/2023 à 17:13

Pourquoi faire simple quand on peut faire compliqué... lol

Sub copie()
 Dim i As Long, lig As Long
 With Workbooks("Source.xlsm").Worksheets("MAIN Questionnaire QA FR")
  For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row
   If Range("E1").Value = "" Then lig = 1 Else lig = Range("E" & Rows.Count).End(xlUp).Row + 1
   Range("E" & lig) = .Range("A" & i).Value
  Next
 End With
End Sub

A+ François

Le 13/08/2023 à 17:29

Avec ouverture de source, copie des données et fermeture de source...

Sub copie()
 Dim i As Long, lig As Long, Chemin As String, NomFichier As String
 Chemin = ActiveWorkbook.Path & "\"
 NomFichier = "Source.xlsm"
 Workbooks.Open Filename:=Chemin & NomFichier
 With Workbooks("Classeur2.xlsm").Worksheets("Synt")
  For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
   If .Range("E1").Value = "" Then lig = 1 Else lig = .Range("E" & Rows.Count).End(xlUp).Row + 1
   .Range("E" & lig).Value = Range("A" & i).Value
  Next
 End With
 ActiveWorkbook.Close
End Sub

A+ François

Le 13/08/2023 à 18:08

Bonjour Francois,

Merci beaucoup pour ton aide, ça fonctionne trés bien sur le fichier test. ceci dit, je n'arrive pas à l'adapter à mon fichier,

au fait, le nom du fichier, les numéros de lignes et colonnes doivent être des variables, si je doit te l'écrire simplement ça donnerais ça ;

(dans le classeur "Classeur2", feuille "Synt", tu me renvoi la valeur qui se trouve dans le classeur (nom du classeur = Classeur2.Synt.D2 &".xlsm"), Feuille ("MAIN Questionnaire QA FR"), Ligne =Classeur2.Synt.A2.valeur, colonne = Classeur2.Synt.B2.valeur,) la valeur récupérée, doit être collée sur la cellule Classeur2.Synt.E2

je t'en suis vraiment reconnaissant pour ton aide.

Le 13/08/2023 à 18:34

Avec des variables

Sub copie()
 Dim i As Long, lig As Long, Chemin As String, NomFichier As String
 Dim sh As Worksheet
 Set sh = ActiveSheet
 'Chemin = ActiveWorkbook.Path & "\"
 Chemin = "D:\Bureau\TRVX_QA\2023\08- QA_Aout_23\Sprint1\Retour AQ\"
 NomFichier = Range("D2").Value & ".xlsm"
 Workbooks.Open Filename:=Chemin & NomFichier
   For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
   If sh.Cells(1, 5).Value = "" Then lig = 1 Else lig = sh.Cells(Rows.Count, 5).End(xlUp).Row + 1
   sh.Cells(lig, 5).Value = Cells(i, 1).Value
  Next
 ActiveWorkbook.Close
End Sub

A+ François

Le 13/08/2023 à 19:18

le code fonctionne trés bien à quelque petit souci :) :)

sur le fichier qu'on ouvre avec l'instruction, Workbooks.Open, il faut qu'on désactive ses macros car elles bug, j'ai essayer de l'ouvrir en lecture seule, mais ça n'a pas marché, uen idée stp ?

merci

Le 13/08/2023 à 19:25

au fait, à chaque nouvelle boucle il m'affiche (Exécution interrompu)

Le 13/08/2023 à 20:00

bonjour,

finalement j'ai pu avancer un peu avec ce qu ej'ai pu trouver sur le web, le seul soucis qui reste, c'est ma feuille ne s'actualise pas et reste figé (je ne peux pas cliquer) jusqu'à ce que je clique sur le (X) pour fermer le classeur, puis annuler, pour que je récupère le contrôle de la feuille, je ne comprends pas pourquoi ?

voilà le code que j'utilise actuellement

Sub copie()
 Dim i As Long, lig As Long, Chemin As String, NomFichier As String
 Dim sh As Worksheet
 Dim nbcells As Long
 Set sh = ActiveSheet

 Chemin = "D:\Bureau\TRVX_QA\2023\08- QA_Aout_23\Sprint1\Retour AQ\"
 NomFichier = Range("O2").Value & ".xlsm"
 nbcells = Application.WorksheetFunction.CountA(Worksheets("Synt").Range("A:A"))
 Application.EnableCancelKey = xlDisabled
 Workbooks.Open Filename:=Chemin & NomFichier
   For i = 2 To nbcells  
   If sh.Cells(i, 16).Value <> "" Then lig = 1 Else lig = sh.Cells(Rows.Count, 16).End(xlUp).Row + 1
   sh.Cells(lig, 16).Value = Cells(sh.Cells(i, 12).Value, sh.Cells(i, 13).Value).Value
   Next
ActiveWorkbook.Close False
End Sub
Le 14/08/2023 à 06:22

Bonjour,

Ca ne ressemble plus au fichier que tu avais joint....

 nbcells = Range("A" & Rows.Count).End(xlUp).Row 'remplace la ligne ci dessous
 'Application.WorksheetFunction.CountA(Worksheets("Synt").Range("A:A"))
 'Application.EnableCancelKey = xlDisabled 'utilisation tres dangereuse
 On Error GoTo gesterr 'gestionnaire d'erreur
 Workbooks.Open Filename:=Chemin & NomFichier
 For i = 2 To nbcells
     If sh.Cells(i, 16).Value <> "" Then lig = 1 Else lig = sh.Cells(Rows.Count, 16).End(xlUp).Row + 1
     sh.Cells(lig, 16).Value = Cells(sh.Cells(i, 12).Value, sh.Cells(i, 13).Value).Value
 Next
 ActiveWorkbook.Close False
 Exit Sub
gesterr:
MsgBox ("ERREUR! " & Chemin & NomFichier)
End Sub

A l'analyse de ton programme tu ouvres un fichier que tu n'utilises pas...

J'arrive pas à comprendre:sh.Cells(lig, 16).Value = Cells(sh.Cells(i, 12).Value, sh.Cells(i, 13).Value).Value...

A+ François

Le 14/08/2023 à 18:00

bonjour Francois,

d'abord je tiens vraiment à te remercier pour ton support et conseils trés précieux pour moi.

j'ai corrigé le code suivant tes recommandations, et pou rla ligne que tu n'a pas compris, voilà l'explicaiton;

sh.Cells(lig, 16).Value = Cells(sh.Cells(i, 12).Value, sh.Cells(i, 13).Value).Value

je renseigne la cellule (sh.Cells(lig, 16).Value) = par, la cellule qui se trouve sur le deuxième fichier (Filename:=Chemin & NomFichier), et je récupère l'adresse de la cette cellule à partir des variables qui sont sur la feuille (sh), n° de ligne (sh.Cells(i, 12).Value) et n° de colonne (sh.Cells(i, 13).Value).

voilà à quoi ressemble mon nouveau code, par contre j'ai un encore un problème, sur la récupération de la deuxième colonne, il ne va pas jusqu'au bout, je dois relancer deux à trois fois le code pour qu'il me complète toutes les cellules, peux tu m'aider stp;

Sub copie()
 Dim i As Long, lig As Long, Chemin As String, NomFichier As String
 Dim sh As Worksheet
 Dim nbcells As Long
 Set sh = ActiveSheet
 Chemin = "D:\Bureau\TRVX_QA\2023\08- QA_Aout_23\Sprint1\Retour AQ\"
 NomFichier = Range("L2").Value & ".xlsm"
 nbcells = Range("A" & Rows.Count).End(xlUp).Row 
 On Error GoTo gesterr 'gestionnaire d'erreur
 Workbooks.Open Filename:=Chemin & NomFichier
 With Workbooks(NomFichier)
 Sheets("MAIN Questionnaire QA FR").Select
   For i = 2 To nbcells
    'reprendre la première valeur à récupérer 
   If sh.Cells(i, 16).Value <> "" Then lig = 1 Else lig = sh.Cells(Rows.Count, 16).End(xlUp).Row + 1
   sh.Cells(lig, 16).Value = Cells(sh.Cells(i, 15).Value, sh.Cells(i, 10).Value).Value
    'reprendre la deuxième valeur à récupérer sur la colonne d'après
   If sh.Cells(i, 17).Value <> "" Then lig = 1 Else lig = sh.Cells(Rows.Count, 17).End(xlUp).Row + 1
   sh.Cells(lig, 17).Value = Cells(sh.Cells(i, 15).Value, sh.Cells(i, 11).Value).Value
   Next
 End With
ActiveWorkbook.Close False
 Exit Sub
gesterr:
MsgBox ("ERREUR! " & Chemin & NomFichier)
End Sub
Le 14/08/2023 à 18:48

Dernière réponse

Ci joint ma solution

16classeur2.xlsm (15.08 Ko)
With Workbooks(NomFichier) 'ça ne sert à rien tu es sur ce fichier
 Sheets("MAIN Questionnaire QA FR").Select 'ça ne sert à rien tu es sur cette feuille
   For i = 2 To nbcells
    'reprendre la première valeur à récupérer 'faux
   If sh.Cells(i, 16).Value <> "" Then lig = 1 Else lig = sh.Cells(Rows.Count, 16).End(xlUp).Row + 1
'sh c'est le fichier classeur2
'donc si je traduis: tu copie sur classeur2 à la derniere ligne +1 (ok normal)
les cellules d'une plage de classeur2
,lignei (1 puis 2 en fonction de la boucle), colonne 15 et ligne i, colonne 10) moi ça plante... (c'est comme si tu avais marqué range("O1:J1")...
   sh.Cells(lig, 16).Value = Cells(sh.Cells(i, 15).Value, sh.Cells(i, 10).Value).Value
la suite ne sert à rien la boucle for next est là pour ça...
    'reprendre la deuxième valeur à récupérer sur la colonne d'après
   If sh.Cells(i, 17).Value <> "" Then lig = 1 Else lig = sh.Cells(Rows.Count, 17).End(xlUp).Row + 1
   sh.Cells(lig, 17).Value = Cells(sh.Cells(i, 15).Value, sh.Cells(i, 11).Value).Value
   Next

A+ François
Le 14/08/2023 à 19:34

le code fonctionne trés bien.

Merci pour ta patience et ton indulgence.

Rechercher des sujets similaires à "variable objet bloc definie"