InputBox pour choisir des classeurs, des feuilles et des colonnes : ne fonctionne pas

Toine45

XLDnaute Junior
Bonjour à tous
Dans une macro : j’ai besoin de choisir un classeur (déjà ouverts), une feuille et une colonne et les affecter à des variables par des inputBox.

A = classeur N°1
B = classeur N° 2
C = feuille X
D = feuille Y
E = colonne A de la feuille X du classeur 1
F = colonne B de la feuille Y du classeur 2
G = colonne F de la feuille Y du classeur 2
H = colonne C de la feuille X du classeur 1

But :
Avec 2 classeurs déjà ouverts, comportant chacun plusieurs feuilles.
Je désirerais choisir le nom de mes 2 classeurs (il peut y en avoirs d’autres ouverts aussi) comparer la feuille 3 du classeur 1 avec la feuille 4 du classeur 2 et, si une référence de la colonne A de la feuille 3 est trouvée, dans la colonne B de la feuille 4 : copier les données de la cellule F de la feuille 4 du classeur 2 (se trouvant sur la même ligne que la référence cherchée), dans la cellule C de la feuille 3 du classeur 1 (en face de cette même référence).
Si la référence n’est pas trouvée dans la feuille 4, ne rien copier.

Les noms des classeurs, feuilles, n° de colonnes peuvent changer : Je voudrais donc définir ces nom avec une InputBox pour ne pas avoir à modifier sans arrêt la macro, de plus, d’autres personnes ne connaissant moins que rien aux macros pourront l’utiliser.
Seulement, je débute en VBA et mes connaissances étant TRES limitées, j’espère une aide de votre part (ça fait plusieurs semaines que j’essai de comprendre et je m’y arrache les cheveux dessus.
Je sais qu’il doit y avoir de grossières erreurs dans mon code (c’est vraiment pas évident, pour un débutant)
(j’ai essayé aussi une piste via un userform (dans mon classeur2) mais il faut encore que je cherche comment faire), la macro ci-dessous me semble plus rapide à faire fonctionner. Je pense avoir le principe, mais la bonne écriture me manque.

Avec tous mes remerciements à ceux qui voudront bien m’aider

Ci-dessous, la macro que je voudrais faire fonctionner :

Code:
Sub A1_inventaire_9_Boites_Dialogue() ' Ne fonctionne pas, (en cours de modifs)
'-compare la cellule "A2" de la colonne "A" feuille "Essai" classeur "Inventaire-Essai.xls" avec toutes les cellules de la colonne "B" de la feuille "Recapitulatif" du classeur "1Emplacement"
'Si une valeur identique est trouvée: Remplacer le contenu de la cellule "3" (C) de la feuille Essai du classeur "Inventaire-Essai.xls"
'par le contenu de la cellule de la colonne "J" de la feuille "Recapitulatif" du classeur "1Emplacement" dont la valeur est la même.
'Sinon reprendre la comparaison a la cellule "A3" et ce jusqu'à la fin de la colonne "A"
    'Travail sur 2 feuilles dans 2 classeurs différents)

'Définition =======================
Dim Cel As Range, Cel_A As Range
Dim F_A As Worksheet, F_B As Worksheet
Dim Fi1 As String, Fi2 As String, F1 As String, F2 As String, C1 As String, C2 As String, D As String, A As String

'Chemin ==============================
Fi1 = InputBox("Nom du fichier 1" & ".xls", "Nom") 'Semble fonctionner
Fi2 = InputBox("Nom du fichier 2" & ".xls", "Nom") 'Semble fonctionner
F1 = InputBox("Nom de la feuille 1", "Feuil") 'Semble fonctionner
F2 = InputBox("Nom de la feuille 2", "Feuil") 'Semble fonctionner

C1 = InputBox("Colonne de référence 1", "Colonne") 'A tester
C2 = InputBox("Colonne de référence 2", "Colonne") 'A tester
D = InputBox("Colonne de Départ de copie)", "Depart") 'A tester
A = InputBox("Colonne d' arrivée (collage)", "Arrivee") 'A tester

'Set F_A = Workbooks("Inventaire-Essai.xls").Sheets("essai") 'Fonctionne
'Set F_B = Workbooks("1Emplacement.xls").Sheets("Recapitulatif") 'Fonctionne
        'ou
Set F_A = Workbooks(Fi1).Sheets(F1) 'Ne fonctionne pas : l'indice n'appartient pas à la sélection.
Set F_B = Workbooks(Fi2).Sheets(F2) 'Ne fonctionne pas : l'indice n'appartient pas à la sélection.

'Traitement =======================
'    For Each Cel In F_A.Range(F_A.[A1], F_A.Range("A" & Rows.Count).End(xlUp))
For Each Cel In F_A.Range(F_A.C1, F_A.Range(C1 & Rows.Count).End(xlUp))     'Erreur compilation
                'Pour chaque cellule de A   'Cel = cellules de références de feuille 3

    If Not (IsEmpty(Cel)) Then
    'si Cel n'est pas vide
   
   Set Cel_A = F_B.C2.Find(Cel)    'Erreur compilation
 '     Set Cel_A = F_B.Columns(C1).Find(Cel)    'Columns(2)= colonne B
        'fixer Cel_a en tant cellule trouvée identique à Cel
        'CelA = cellules de références de feuille 4

                    If Not (Cel_A Is Nothing) Then
                    'si Cel_A existe

  'Plusieurs options (à désactiver ou à activer selon les besoins) mais plus utiles si input box fonctionne.

            'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 1)).Copy F_B.Cells(Cel_A.Row, "B")
            'Copie les cellules B et C de la feuille 3 en C et D de la feuille 4
            'copier B et C de Cel sur C et D de Cel_A
            
            'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 2)).Copy F_B.Cells(Cel_A.Row, "B")
            'copier B et C de Cel sur C et D de Cel_A
            
            'F_B.Range(Cel_A.Offset(0, 1), Cel_A.Offset(0, 1)).Copy F_A.Cells(Cel.Row, "e")
            'Copie les cellules C de la feuille 4 en E de la feuille 3

'F_B.Range(Cel_A.Offset(0, 4), Cel_A.Offset(0, 4)).Copy F_A.Cells(Cel.Row, "C")
'Copie les cellules F de la feuille 4 en C de la feuille 3
'(J=9 : Colonne de référence + différence pour colonne à copier)

        F_B.Range(C2.D, C2.D).Copy F_A.Cells(Cel.Row, A)  'A tester
        'Copie les cellules F de la feuille 4 en C de la feuille 3
        '(J=9 : Colonne de référence + différence pour colonne à copier)
        End If
    End If
Next Cel    'Cel suivante
End Sub

Macro qui fonctionne : (mais obligé de tout modifier à chaque changement de noms) :
(si ça peut aider quelqu’un) et pour l’exemple de ce que je veux faire

Code:
Sub A_inventaire_9_Base() '(Fonctionne)
        '(Obligation de définir tous les chemins en modifiant la macro)
        
'-compare la cellule "A2" de la colonne "A" feuille "AA" classeur "Classeur1.xls" avec toutes les cellules de la colonne "B" de la feuille "Toto" du classeur "Classeur2" (les noms peuvent changer)
'Si une valeur identique est trouvée: Remplacer le contenu de la cellule "3" (C) de la feuille AA du classeur "Classeur1.xls"
'par le contenu de la cellule de la colonne "F" de la feuille "Toto" du classeur "Classeur2.xls" dont la valeur est la même.
'Sinon reprendre la comparaison a la cellule "A3" et ce jusqu'à la fin de la colonne "A"
    'Travail sur 2 feuilles dans 2 classeurs différents)(les noms des feuilles et des classeurs peuvent changer)

'Définition =======================
Dim Cel As Range, Cel_A As Range
Dim F_A As Worksheet, F_B As Worksheet

'Chemins ==============================
Set F_A = Workbooks("Classeur1.xls").Sheets("AA")
Set F_B = Workbooks("Classeur2.xls").Sheets("Toto")
        'ou
'Set F_A = Workbooks("Classeur1.xls").Sheets(1)
'Set F_B = Workbooks("Classeur2.xls").Sheets(3)

'Traitement =======================
For Each Cel In F_A.Range(F_A.[A1], F_A.Range("A" & Rows.Count).End(xlUp)) 'Pour chaque cellule de A
'Cel = cellules de références de feuille 3
 
   If Not (IsEmpty(Cel)) Then     'si Cel n'est pas vide

             Set Cel_A = F_B.Columns(2).Find(Cel)    'Columns(2)= colonne B
              'fixer Cel_a en tant cellule trouvée identique à Cel  'CelA = cellules de références de feuille 4
            
                 If Not (Cel_A Is Nothing) Then 'si Cel_A existe
                    
'Copie =======================
            'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 1)).Copy F_B.Cells(Cel_A.Row, "B")
            'Copie les cellules B et C de la feuille 3 en C et D de la feuille 4
            'copier B et C de Cel sur C et D de Cel_A
            
            'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 2)).Copy F_B.Cells(Cel_A.Row, "B")
            'copier B et C de Cel sur C et D de Cel_A
            
            'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 1)).Copy F_B.Cells(Cel_A.Row, "c")
            'Copie les cellules B de la feuille 3 en D de la feuille 4

            'F_B.Range(Cel_A.Offset(0, 1), Cel_A.Offset(0, 1)).Copy F_A.Cells(Cel.Row, "c")
            'Copie les cellules B de la feuille 4 en C de la feuille 3
            
            'F_B.Range(Cel_A.Offset(0, 1), Cel_A.Offset(0, 1)).Copy F_A.Cells(Cel.Row, "e")
            'Copie les cellules C de la feuille 4 en E de la feuille 3

F_B.Range(Cel_A.Offset(0, 4), Cel_A.Offset(0, 4)).Copy F_A.Cells(Cel.Row, "C")
'Copie les cellules F de la feuille 3 en C de la feuille 1
'(F=4 : Colonne de référence + différence pour colonne à copier)

            'F_B.Range(Cel_A.Offset(0, 9), Cel_A.Offset(0, 6)).Copy F_A.Cells(Cel.Row, "C")
            'Copie les cellules H, I, J, K de la feuille 4 en C, D, E, F de la feuille 3
        End If
    End If
Next Cel    'Cel suivante
End Sub

Merci à ceux qui auront bien voulu me donner un coup de main.
 

Pièces jointes

  • Classeur1.xls
    85 KB · Affichages: 59
  • Classeur2.xls
    128.5 KB · Affichages: 63
  • Classeur1.xls
    85 KB · Affichages: 59
  • Classeur2.xls
    128.5 KB · Affichages: 63
  • Classeur1.xls
    85 KB · Affichages: 62
  • Classeur2.xls
    128.5 KB · Affichages: 60
Dernière édition:

Paf

XLDnaute Barbatruc
Re : InputBox pour choisir des classeurs, des feuilles et des colonnes : ne fonctionn

bonjour,

1) il faut être sûr que les noms de feuille existent bien dans les classeurs voulus

2) mauvaise recopie entre le code qui fonctionne (Set F_A = Workbooks("Classeur1.xls").Sheets(1)) et le code qui ne fonctionne pas (Set F_A = Workbooks(Fi1).Sheet(F1))

Voir dans l'aide la différence entre Sheets et Sheet

Bonne suite
 

Toine45

XLDnaute Junior
Re : InputBox pour choisir des classeurs, des feuilles et des colonnes : ne fonctionn

Bonjour
Merci pour la réponse......mais ça ne m'aide pas beaucoup, j'ai corrigé cette faute, mais c'est pas là qu'était mon problème
c'est au niveau du traitement comme je l'ai signalé je débute...on ne demande pas à un gosse de faire une rédaction sans lui apprendre à faire des phrase avant.
ce qu'il me faut, c'est un minimum de conseil, ou des exemples.
Je pense avoir compris le principe, mais ne sais pas l'écrire.

Partie ne fonctionnant pas :

Code:
'Traitement =======================

For Each Cel In F_A.Range(F_A.C1, F_A.Range(C1 & Rows.Count).End(xlUp))     'Erreur compilation

    If Not (IsEmpty(Cel)) Then
   
   Set Cel_A = F_B.C2.Find(Cel)    'Erreur compilation
        					'fixer Cel_a en tant cellule trouvée identique à Cel

                    If Not (Cel_A Is Nothing) Then		 'si Cel_A existe

  'Plusieurs options (à désactiver ou à activer selon les besoins) mais plus utiles si InputBox fonctionne.

           		'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 1)).Copy F_B.Cells(Cel_A.Row, "B")
           		'Copie les cellules B et C de la feuille 3 en C et D de la feuille 4
           		'copier B et C de Cel sur C et D de Cel_A
            

'F_B.Range(Cel_A.Offset(0, 4), Cel_A.Offset(0, 4)).Copy F_A.Cells(Cel.Row, "C") 
'Copie les cellules F de la feuille 4 en C de la feuille 3
'(J=9 : Colonne de référence + différence pour colonne à copier)

     F_B.Range(C2.D, C2.D).Copy F_A.Cells(Cel.Row, A)  'A tester (plante avant d’arriver là)
‘(je viens de voir qu’il va certainement me manquer un « Offset » pour le « collage » en face de la réf.)

        'Copie les cellules F de la feuille 4 en C de la feuille 3 (ou autres selon inputBox)
               End If

Merci pour les futures aides
 

Dranreb

XLDnaute Barbatruc
Re : InputBox pour choisir des classeurs, des feuilles et des colonnes : ne fonctionn

Bonjour.
Je me suis créé un userform qui permet de choisir des plages dans différentes feuille de différents classeurs en les sélectionnant.
L'utilisateur peut être clairement informé de ce qu'il doit sélectionner à chaque étape (ce que c'est, pas l'endroit où c'est), il peut naviguer entre les étapes jusqu'à ce que tout est bon puis lancer par un bouton "Go!" une certaine macro qui reçoit, en paramètres, pour travailler, un tableau d'objets Range. Cela vous intéresse-t-il ?
 

Toine45

XLDnaute Junior
Re : InputBox pour choisir des classeurs, des feuilles et des colonnes : ne fonctionn

Bonjour Dranreb
Merci beaucoup de t'être penché sur mon problème,
Oui, bien sûr, toutes les solutions sont les bien-venues, j' essaierai de l'adapter à mon cas
voici où j'en suis (j'ai remis mon 2 ème fichier modifié)
mais il y a des erreurs de syntaxe car je pratique le VBA depuis peu et il y a tellement à apprendre....
Pas facile d'apprendre tout seul, sur le tas.
il faudrait que je trouve quelq'un pour me corriger mes grossières erreurs (ça doit sauter aux yeux des pros)
j'ai ajouté un contrôle des fichiers et des feuilles mais je ne suis pas certain que ça fonctionne mais le principe doit y être.


Code:
Sub A1_inventaire_9_Boites_Dialogue_Test() ' Ne fonctionne pas, (en cours de modifs)
'-compare la cellule "A2" de la colonne "A" feuille "Essai" classeur "Inventaire-Essai.xls" avec toutes les cellules de la colonne "B" de la feuille "Recapitulatif" du classeur "1Emplacement"
'Si une valeur identique est trouvée: Remplacer le contenu de la cellule "3" (C) de la feuille Essai du classeur "Inventaire-Essai.xls"
'par le contenu de la cellule de la colonne "J" de la feuille "Recapitulatif" du classeur "1Emplacement" dont la valeur est la même.
'Sinon reprendre la comparaison a la cellule "A3" et ce jusqu'à la fin de la colonne "A"
    'Travail sur 2 feuilles dans 2 classeurs différents)

'Définition =======================
Dim Cel As Range, Cel_A As Range
Dim F_A As Worksheet, F_B As Worksheet
Dim Fi1 As String, Fi2 As String, F1 As String, F2 As String, C1 As String, C2 As String, D As String, A As String
Dim Wk1 As Workbook, Wk2 As Workbook

'Attribution des variables ==============================
Fi1 = InputBox("Nom du fichier 1" & ".xls", "Nom1") 'Semble fonctionner
Fi2 = InputBox("Nom du fichier 2" & ".xls", "Nom2") 'Semble fonctionner
F1 = InputBox("Nom de la feuille 1", "Feuil1") 'Semble fonctionner
F2 = InputBox("Nom de la feuille 2", "Feuil2") 'Semble fonctionner

C1 = InputBox("Colonne de référence 1", "Colonne1") 'A tester
C2 = InputBox("Colonne de référence 2", "Colonne2") 'A tester
D = InputBox("Colonne de Départ de copie)", "Depart") 'A tester
A = InputBox("Colonne d' arrivée (collage)", "Arrivee") 'A tester

'Vérification d'ouverture des classeurs ==============================
On Error Resume Next
Set Wk1 = Workbooks(Fi1 & ".xls")
If Err <> 1 Then
    GoTo Ouverture_Fichier
Else
    'MsgBox "Le fichier " & Fi1 & " est déja ouvert"
   ' Next
End If
On Error Resume Next
Set Wk2 = Workbooks(Fi2 & ".xls")
If Err <> 1 Then
    GoTo Ouverture_Fichier
Else
    'MsgBox "Le fichier " & Fi2 & " est déja ouvert"
    'Next
End If

'Pour mémoire : (Macro d'ouverture de classeur)
            'Sub Ouverture_Fichier()
            'Dim Chemin_et_Fichier As String, Fichier As String, Rep_Fichier As String
            'recuperation du chemin et nom de fichier
            'Chemin_et_Fichier = RechercheFichier(Rep_Fichier)
            'If Chemin_et_Fichier = "" Then
            'MsgBox "Vous n'avez sélectionné aucun fichier"
            'Else
            'ouverture ficher selectionne
            'Workbooks.Open (Chemin_et_Fichier)
            'End If
            'End Sub
            
'Vérification du nom des feuilles ==============================
'Vérifie que les feuilles demandées existent
 Dim myArray As Variant, Nom As Variant 'déclaration des variables
 myArray = Array(F1, "F2") 'création d'une variable dite Array avec 2 valeurs
 For Each Nom In myArray 'boucle dans la variable Array
 If TestOnglet(Nom) = False Then 'Test appelant la fonction
    MsgBox "La feuille " & Nom & " n'existe pas."
 End If 'fin de la condition
 Next Nom 'appel de l'élément suivant de l'Array

'Attribution des chemins ==============================
Set F_A = Workbooks(Fi1).Sheet(F1) 'Ne fonctionne pas : l'indice n'appartient pas à la sélection.
Set F_B = Workbooks(Fi2).Sheet(F2) 'Ne fonctionne pas : l'indice n'appartient pas à la sélection.

'Traitement =======================
'    For Each Cel In F_A.Range(F_A.[A1], F_A.Range("A" & Rows.Count).End(xlUp))
For Each Cel In F_A.Range(F_A.C1, F_A.Range(C1 & Rows.Count).End(xlUp))     'Erreur compilation
                'Pour chaque cellule de A   'Cel = cellules de références de feuille 3

    If Not (IsEmpty(Cel)) Then
    'si Cel n'est pas vide
   
   Set Cel_A = F_B.C2.Find(Cel)    'Erreur compilation
 '     Set Cel_A = F_B.Columns(C1).Find(Cel)    'Columns(2)= colonne B
        'fixer Cel_a en tant cellule trouvée identique à Cel
        'CelA = cellules de références de feuille 4

                    If Not (Cel_A Is Nothing) Then
                    'si Cel_A existe

            'F_A.Range(Cel.Offset(0, 1), Cel.Offset(0, 1)).Copy F_B.Cells(Cel_A.Row, "B")
            'Copie les cellules B et C de la feuille 3 en C et D de la feuille 4
            'copier B et C de Cel sur C et D de Cel_A
            
           
'F_B.Range(Cel_A.Offset(0, 4), Cel_A.Offset(0, 4)).Copy F_A.Cells(Cel.Row, "C")
'Copie les cellules F de la feuille 4 en C de la feuille 3
'(J=9 : Colonne de référence + différence pour colonne à copier)

        F_B.Range(C2.D, C2.D).Copy F_A.Cells(Cel.Row, A)  'A tester
        'Copie les cellules F de la feuille 4 en C de la feuille 3
        '(J=9 : Colonne de référence + différence pour colonne à copier)
        End If
    End If
Next Cel    'Cel suivante
End Function

Function TestOnglet(Nom As Variant) As Boolean 'sous programme
 On Error Resume Next 'désactive l'éventuel message d'erreur
 TestOnglet = Sheets(Nom).Name <> "" 'code du test
 On Error GoTo 0 'réactive le contrôle des erreurs
 End Function
 

Pièces jointes

  • Classeur2.xls
    137 KB · Affichages: 58
  • Classeur2.xls
    137 KB · Affichages: 58
  • Classeur2.xls
    137 KB · Affichages: 54

Toine45

XLDnaute Junior
Re : InputBox pour choisir des classeurs, des feuilles et des colonnes : ne fonctionn

Merci Dranreb
Je testerai demain au travail, car chez moi, je suis sur Linux avec LibreOffice et les macros ne sont pas compatibles, ce n'est pas le même langage, et excel ne fonctionne en émulation qu' avec des macros très simples, mais la plus part ne fonctionnent pas non plus.
Merci beaucoup et bonne soirée
 

Discussions similaires

Réponses
4
Affichages
549
Réponses
2
Affichages
148

Statistiques des forums

Discussions
294 232
Messages
1 937 081
Membres
188 145
dernier inscrit
Peres2