Recupérer le numero de colonne pour recap

[CelluleVide]

Bonjour a tous,

J'ai besoin d'automatiser la récupération de valeur dans plusieurs onglets: le problème etant que la position de la valeur peut changer dans chaque onglet.
Nayant pas la main sur le fichier source je ne peux pas en modifier la structure.

La solution serait peut être de retrouver dans chaque onglet le numero de colonne de la valeur indiquée en A5 dans cet onglet "RECAP" ( puisque cette valeur se trouve en haut de la colonne dans chaque onglet) puis la derniere ligne de la colonne trouvée.

Avec un fichier en PJ

Merci.

 

[VDAVID]

Re : Recupérer le numero de colonne pour recap

Bonjour Cellule vide,

Voici un exemple de code que tu peux insérer dans le module de ton classeur:

Option Explicit
Option Base 1
Option Compare Text


Sub Recherche()
    
    
    'Déclaration des variables
    Dim maPlage As Range, Cel As Range, c As Range
    Dim ValChercher As String
    Dim Ws As Worksheet
    
    Set Ws = ThisWorkbook.Sheets("RECAP")
    
    'Le libellé à chercher dans les autres feuilles (Dans l'exemple présent en [A5] de la feuille "RECAP")
    ValChercher = Ws.Range("A5").Value
    
    'Plage de cellule où se trouve les mois (Doivent correspondrent au nom des feuilles)
    Set maPlage = Ws.Range("C4:E4")
    
    For Each Cel In maPlage
         
        'Si aucune feuille ne porte le nom du mois, on passe à la suivante
        On Error Resume Next
            
            'Avec la feuille ayant pour nom le mois correspondant
            With ThisWorkbook.Sheets(Cel.Value)
                
                'On cherche le libellé ValChercher dans la feuille
                Set c = .Cells.Find(ValChercher, , xlValues, xlWhole)
                
                'On vérifie qu'il y'ait une correspondance
                If Not c Is Nothing Then
                    
                    Cel.Offset(1, 0).Value = .Cells(.Cells(65536, c.Column).End(xlUp).Row, c.Column).Value
                
                Else
                
                    MsgBox "Le libellé: " & ValChercher & " n'a pas été trouvé dans la feuille " & .Name, vbCritical, "Attention"
                
                End If
                
            
            End With
    
    Next Cel

End Sub

N'hésite pas si tu as des questions!

Bonne journée !

 

[CelluleVide]

Re : Recupérer le numero de colonne pour recap

Bonjour VDAVID,
J'ai testé ta solution qui fonctionne bien ( et avec les commentaires du code qui plus est!)
ça marche impeccable mais je dois l'adapter au classeur de travail;
J'aurai surement d'autre question.
Merci en attendant.

A+

 

[CelluleVide]

Re : Recupérer le numero de colonne pour recap

Re:
Ce que je craignais est bien arrivé, J'ai tenté de mettre en place avec le fichier source mais sans résultats.

Le probleme doit se situer dans la récupération des données sur un autre fichier.
Malgré toutes mes tentatives pas de mieux.

La source n'est que peu modifiable et comporte des cellules fusionnées qui sont peut etre la cause du probleme.

Je joins le fichier source si ça peut aider.

A+

 

[VDAVID]

Re : Recupérer le numero de colonne pour recap

Re,

Essaye peut-être comme ceci:

Option Explicit
Option Base 1
Option Compare Text


 Sub Recherche()
     
     
     
     'Déclaration des variables
     Dim i As Integer
     Dim maPlage As Range, Cel As Range, c As Range
     Dim ValChercher, Chemin  As String
     Dim Ws As Worksheet, Ws1 As Worksheet
     Dim CLASSEUR As String
     Dim Flag1 As Boolean
     
CLASSEUR = "C:\Users\david-v\Desktop\Source%20Recap(1).xlsm"
  'Chemin = "V:\Production\Partagé\PRODUCTION\productivité\cuisine"
  'CLASSEUR = "V:\Production\Partagé\PRODUCTION\productivité\cuisine\Productivité Montage 2014.xls"
  'GetData chemin(1) & fichier(1), feuille(1), cellules(1),

     For i = 1 To Application.Windows.Count
        
        If Workbooks(i).FullName = CLASSEUR Then
        
            Flag1 = True
        
        Else
            
            Workbooks(i).Activate
        
        End If
     Next i
     
     If Flag1 = False Then Workbooks.Open (CLASSEUR)
     
        
     Set Ws = ThisWorkbook.Sheets("RECAP")
     
     'Le libellé à chercher dans les autres feuilles (Dans l'exemple présent en [A5] de la feuille "RECAP")
     ValChercher = Ws.Range("A5").Value
     
     'Plage de cellule où se trouve les mois (Doivent correspondrent au nom des feuilles)
     Set maPlage = Ws.Range("C4:H4")
     
     For Each Cel In maPlage
          
         'Si aucune feuille ne porte le nom du mois, on passe à la suivante
         'On Error Resume Next
             
             'Avec la feuille ayant pour nom le mois correspondant
             For i = 1 To ActiveWorkbook.Sheets.Count
                
                If ActiveWorkbook.Sheets(i).Name Like "*" & Cel.Value & "*" And Cel.Value <> "" Then Set Ws1 = ActiveWorkbook.Sheets(i)
             
             Next i
             
             If Not Ws1 Is Nothing Then
             
             With Ws1
                    
                    'On cherche le libellé ValChercher dans la feuille
                    Set c = .Cells.Find(ValChercher, , xlValues, xlWhole)
                    
                    MsgBox Ws1.Name & vbNewLine & c.Address & .Cells(.Cells(65536, c.Column).End(xlUp).Row, c.Column).Value
                    'On vérifie qu'il y'ait une correspondance
                    If Not c Is Nothing Then
                        
                        Cel.Offset(1, 0).Value = .Cells(.Cells(65536, c.Column).End(xlUp).Row, c.Column).Value
                    
                    Else
                    
                        MsgBox "Le libellé: " & ValChercher & " n'a pas été trouvé dans la feuille " & .Name, vbCritical, "Attention"
                    
                    End If
                    
                
                End With
                Set Ws1 = Nothing
             
             End If
     
     Next Cel

 End Sub

Il faut que tu remplaces la variable CLASSEUR par le chemin de ton fichier.

Chez moi ça fonctionne, mais n'hésite pas si tu as des soucis !
A+

 

[CelluleVide]

Re : Recupérer le numero de colonne pour recap

VDAVID,

Merci pour ton aide, Apres essais chez moi:

A l'instruction:
MsgBox Ws1.Name & vbNewLine & c.Address & .Cells(.Cells(65536, c.Column).End(xlUp).Row, c.Column).Value

Il trouve bien l'adresse de la cellule dans chaque onglet mais il n'y a pas la partie valeur
(.Cells(.Cells(65536, c.Column).End(xlUp).Row, c.Column).Value ==> ne donne rien.

 

[VDAVID]

Re : Recupérer le numero de colonne pour recap

CelluleVide,
y'a t-il des cellules non vides après les totaux dans tes feuilles? (pour la colonne trouvée)./ Le nombre total de lignes non vides dépasse t'il 65536?

L'idée de la macro c'est de "trouver" où est le libellé que tu cherches dans la feuille, puis de récupérer la valeur de la dernière cellule non vide de cette colonne.

 

[CelluleVide]

Re : Recupérer le numero de colonne pour recap

VDAVID,
Il y avait bien des cellules contenant des blancs mais sur lesquelles le Xlup s'arretait d'ou les valeur nulles.
Désolé de t'avoir fait perdre ton temps sur ce coup là...

Merci

 

[VDAVID]

Re : Recupérer le numero de colonne pour recap

Pas de soucis !
C'est super si ça marche chez toi aussi

Bonne soirée!

 

[CelluleVide]

Re : Recupérer le numero de colonne pour recap

J'ai encore des questions mais là, je dois partir.
Je me permettrais de t'embeter encore demain matin.
Bonne Soirée.

 

[CelluleVide]

Re : Recupérer le numero de colonne pour recap

Bonjour,

Comme promis je reviens vers vous et surtout vers VDAVID qui m'a bien aidé hier.

Le code fonctionne mais je voudrais maintenant boucler pour avoir les infos des autres indicateurs.
Autre probleme relévé: la macro ne fonctionne que si le fichier source est fermé.

Le message d'erreur ne fonctionne pas non plus.

A+

 

[VDAVID]

Re : Recupérer le numero de colonne pour recap

CelluleVide,

Essaye comme ceci:

Option Explicit
 Option Base 1
 Option Compare Text
 Sub Recherche()
      
      
      
      'Déclaration des variables
      Dim i As Long, h As Long, Lig, NoLigne, Valeur As Integer
      Dim maPlage As Range, Cel As Range, C As Range, Cel1 As Range, maPlage1 As Range
      Dim ValChercher, Chemin  As String
      Dim Ws As Worksheet, Ws1 As Worksheet
      Dim CLASSEUR As String
      Dim Flag1 As Boolean
      
'Indiquer l'emplacement complet du fichier (chemin + nom + ext)
   'CLASSEUR = "V:\Production\Partagé\PRODUCTION\productivité\cuisine\Copie de Productivité Montage 2014.xls"
    CLASSEUR = "C:\Users\david-v\Desktop\Layout\Source.xlsm"
      For i = 1 To Application.Windows.Count
         
         If Workbooks(i).FullName = CLASSEUR Then
         
             Flag1 = True
             Workbooks(i).Activate
             
         End If
         
      Next i
      
      If Flag1 = False Then Workbooks.Open (CLASSEUR)
      
            
      Set Ws = ThisWorkbook.Sheets("RECAP")

      'Le libellé à chercher dans les autres feuilles (Dans l'exemple présent en [A5] de la feuille "RECAP"
      Set maPlage1 = Ws.Range("A5:A" & Ws.Range("A65536").End(xlUp).Row)
      Set maPlage = Ws.Range("C4:H4")
      
      'Plage de cellule où se trouve les mois (Doivent correspondrent au nom des feuilles)
      
      For Each Cel1 In maPlage1
        
        ValChercher = Cel1.Value
        
      For Each Cel In maPlage
          'Si aucune feuille ne porte le nom du mois, on passe à la suivante
          '
          On Error Resume Next
          
              'Avec la feuille ayant pour nom le mois correspondant
              For i = 1 To ActiveWorkbook.Sheets.Count
                 If ActiveWorkbook.Sheets(i).Name Like "*" & Cel.Value & "*" And Cel.Value <> "" Then Set Ws1 = ActiveWorkbook.Sheets(i)
              Next i
              
              If Not Ws1 Is Nothing Then
              
               With Ws1
               
                     'On cherche le libellé ValChercher dans la feuille
                     Set C = .Cells.Find(ValChercher, , xlValues, xlWhole)
                       
                     'On vérifie qu'il y'ai une correspondance
                     
                     If Not C Is Nothing Then

                         Ws.Cells(Cel1.Row, Cel.Column).Value = .Cells(.Cells(65536, C.Column).End(xlUp).Row, C.Column).Value
                         
                       Else
                       
                         MsgBox "Le libellé: " & ValChercher & " n'a pas été trouvé dans la feuille " & .Name, vbCritical, "Attention"
                         
                     End If
                     
                    Set C = Nothing
                    
               End With
               
               Else
               
                    MsgBox "La feuille correspondant à " & Cel.Value & " n'a pas été trouvée", vbCritical, "Attention"
                
          End If
          Set Ws1 = Nothing
          Next Cel
          
          Next Cel1
          
          
Ws.Activate

  End Sub

Concernant le problème du classeur ouvert, c'est résolu.
Le message d'erreur fonctionne cependant, le problème vient des cellules non vides après les tableaux (Comprenant juste des espaces). Le libellé est trouvé à chaque fois mais c'est le renvoi qui n'est pas bon.

 

[CelluleVide]

Re : Recupérer le numero de colonne pour recap

Bonjour VDAVID,
Apres essais et correction du probleme des cellules avec espace (Pour trouver la bonne ligne je mets:
a la place de "Cells(65536, C.Column).End(xlUp).Row " ==> Cells(65536, 1).End(xlUp).Row + 1
ça marche super. Je dois encore controler quelques points.

Un grand merci pour ton aide.

 

[VDAVID]

Re : Recupérer le numero de colonne pour recap

Pas de problème !
Un autre solution, pour contourner le problème:

A la place d'aller chercher la dernière cellule non vide, tu peux inscrire en "dur" le numéro de la ligne total, si elle ne varie pas.
Dans l'exemple, on peut voir que cette ligne est toujours 37.
Ca éviterai d'avoir le retraitement à faire en amont.

Autre solution, appeler ce code dans la procédure, permettant de "clearer" toutes les cellules ne contenant que des espaces:

Sub TrimFeuille()
    
    Dim maPlageTrim As Range, CelTrim As Range
    
    Set maPlageTrim = Range(Cells(1, 1), Cells.SpecialCells(xlCellTypeLastCell))
    
    For Each CelTrim In maPlageTrim
        
        CelTrim.Value = Trim(CelTrim.Value)
    
    Next CelTrim
    
End Sub