[VBA] mise à jour automatique d'une cellule

mise à jour automatique d'une cellule [VBA] - VB/VBA/VBS - Programmation

Marsh Posté le 03-07-2013 à 17:10:37    

Bonjour,
 
J'espère que quelqu'un a la solution à mon problème qui est le suivant :  
 
J'ai un classeur Excel contenant plusieurs feuilles dont une servant à synthétiser mes données. Mon projet est de suivre l'évolution de données dans le temps . Exemple: Feuille1, je récupère le contenu de D5, Feuille2, contenu de G8 etc....
Je souhaiterais trouver une astuce me permettant de mettre à jour automatiquement ma feuille de synthèse g lorsque j'ajoute une nouvelle feuille au classeur. Par exemple je veux que ma feuille de synthèse aille chercher dans la feuille4 (qui n'existe pas encore ) la cellule M278.  
Ma première idée était tout simplement d'entrer la formule suivante ='Feuille4'!M278. Cependant les données ne sont pas mises à jour automatiquement, j'ai "#REF! "qui apparait dans la cellule et je dois double-cliquer afin que cela soit mis à jour.
 
J'espère avoir été assez clair, et que quelqu'un a une solution à mon problème (que ce soit en VBA ou une simple astuce Excel !)
 
D'avance merci pour votre aide

Reply

Marsh Posté le 03-07-2013 à 17:10:37   

Reply

Marsh Posté le 03-07-2013 à 17:42:17    

Salut,
 
En fait il faut boucler sur toutes les feuilles du classeur!
La méthode For...Each...in...next devrait faire l'affaire.
Cette méthode permet de parcourir une collection d'objet sans en connaître l'étendu, à la différence d'une boucle For...Next.
 

Code :
  1. Dim Feuille as WorkSheet
  2. Dim Feuilles as WorkSheets
  3. For Each Feuille in Feuilles
  4.      If Not(Feuille.index)=0
  5.           'Mon code'
  6.      End If
  7. Next


 
Ceci devrait aller, à tester car je ne suis pas devant le PC mais en vacances!
Tiens moi au courant.

Reply

Marsh Posté le 04-07-2013 à 10:46:30    

Hello !
merci pour ta réponse, cependant j'ai trouvé une solution qui correpond exactement à ce que je cherchais la voici, elle sera surement utile à d'autre utilisateurs :
 
1.Sub Acompte()
2.Dim i, Acompt, x, y, Dt
3.x = 1
4.y = 44
5.    For i = 3 To Worksheets.Count
6.        Acompt = 0
7.        Acompt = Sheets("Situation N°" & x).Range("D40" ).Value
8.        Dt = Sheets("Situation N°" & x).Range("C14" ).Value
9.        Sheets("Decompte" ).Activate
10.        Range("A" & y).Value = Acompt
11.        Range("B" & y).Value = Dt
12.        x = x + 1
13.        y = y + 1
14.    Next i
15.End Sub
 
 
Ca me eprmet de récupérer les dates et les valeurs de plusieurs feuille pour les synthétiser dans une feuille.
 
Merci encore mmarle !

Reply

Marsh Posté le 11-03-2015 à 00:13:20    

Bonjour a tous !!!
 
J'arrive remplis de détresse à propos d'un travail qu'on m'a chargé de faire : créer une macro permettant la mise à jour des nouveaux tickets et de rajouter les nouveaux ticket à la suite d'un fichier que je tiens en local ( j'ai un fichier que je tiens en xslm que je met à jour via un fichier csv que j'exporte depuis un appli web). Voilà un code qui fonctionnais parfaitement mais je ne sais pas pourquoi il ne fonctionne plus ( les nouveaux tickets se rajoute mais ceux dejà existant ne se mettent pas à jour et cela creer du coup des doublons car il se rajoute une deuxieme fois ) je vous montre mon code que j'ai adapté par rapport au demande qui m'ont été transmise . En gros je pense qu'il n'y a que la fonction mis à jour qui merde merciiiiiiiiiiiiiiiiiiii a tous svp qui peut m'aider au plus vite .. merci d'avance  
 
Sub Traitement_Fichier()
    Call sup_feuil_Export       ' au cas ou vous faites des essais
    Application.ScreenUpdating = False
    'import infos et mise a jour fichier local
    Import_FExport
    Majour_Tickets
    Application.ScreenUpdating = True
End Sub
 
Sub Import_FExport()
     
    Chemin_Fichier = "C:\Users\Mohamed\Desktop\macro\"
    nom_fichier = "export.csv"
    Workbooks.Open Filename:=Chemin_Fichier & nom_fichier, local:=True
    Sheets("export" ).Move After:=ThisWorkbook.Worksheets("Date" )
    ActiveSheet.Name = "Export"
End Sub
 
Sub Majour_Tickets()
    'figeage ecran
    Application.ScreenUpdating = False
    With Worksheets("Export" )
        If .Range("A2" ) = Empty Then
            MsgBox "Pas de Tickets dans le fichier EXPORT !!!!!!!", vbExclamation, "INFOS FICHIER EXPORT.CSV"
            Exit Sub
        End If
        '$$$$$$$$$$$$$$$$$$ suppression lignes vides: a supprimer si pas de lignes vides$$$$$$$$
        'derniere cellule non vide colonne A
        ligFex = .Range("A" & Rows.Count).End(xlUp).Row
        Cells.Select
        ActiveWorkbook.Worksheets("Export" ).Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Export" ).Sort.SortFields.Add Key:=Range("I2:I" & ligFex) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Export" ).Sort
            .SetRange Range("A1:M" & ligFex)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
        'derniere cellule non vide colonne A
        ligFex = .Range("A" & Rows.Count).End(xlUp).Row
        'mise en memoire plage de numero de tickets
        Set PlageEx = .Range("A2:A" & ligFex)
    End With
    With Worksheets("local" )
        'derniere cellule non vide colonne A
        derlig2 = .Range("A" & Rows.Count).End(xlUp).Row
        'mise en memoire plage de numero de tickets
        Set Col_A = .Range("A2:A" & derlig2)
    End With
    'boucle recherche ticket export/local
    For Each cel In PlageEx
        With Worksheets("local" )
            'recherche si doublon(s)
            Nbre = Application.CountIf(Col_A, cel)
            'desactive les evenements EXCEL
            Application.EnableEvents = False
            If Nbre = 1 Then    'Tickets anciens
                ligTic1 = 1
                'recherche ligne ticket local
                ligTic1 = .Columns("A" ).Find(cel, .Cells(ligTic1, "A" ), , xlWhole).Row
                'copie pour mise a jour anciens tickets cellule H-M
                .Range("H" & ligTic1 & ":M" & ligTic1) = Worksheets("Export" ).Range("H" & cel.Row & ":M" & cel.Row).Value
                'test si cellules BCD modifiees
                With Worksheets("Mem_Modif_BCD" )
                    'derniere cellule non vide colonne A
                    derlig = .Range("A" & Rows.Count).End(xlUp).Row
                    If derlig > 1 Then  'plus d'un ticket memorise
                        'mise en memoire plage de numero de tickets
                        Set plage = .Range("A2:A" & derlig)
                        'nombre de fois le ticket
                        Ex = Application.CountIf(plage, cel)
                        If Ex = 1 Then  'existe une fois donc cellule(s) modifiee(s)
                            ligEx = 1
                            'recherche ligne ticket Mem_Modif_BCD
                            ligEx = .Columns("A" ).Find(cel, .Cells(ligEx, "A" ), , xlWhole).Row
                            'mise en table modif cellules BCD
                            TM = .Range("B" & ligEx & ":D" & ligEx)
                            If TM(1, 1) = Empty Then    'pas de modif cellule B
                                'mise ajour cellule B local
                                Worksheets("local" ).Range("B" & ligTic1) = Worksheets("Export" ).Range("B" & cel.Row).Value
                            End If
                            If TM(1, 2) = Empty Then    'pas de modif cellule C
                                'mise ajour cellule C local
                                Worksheets("local" ).Range("C" & ligTic1) = Worksheets("Export" ).Range("C" & cel.Row).Value
                            End If
                            If TM(1, 3) = Empty Then    'pas de modif cellule D
                                'mise ajour cellule D local
                                Worksheets("local" ).Range("D" & ligTic1) = Worksheets("Export" ).Range("D" & cel.Row).Value
                            End If
                        ElseIf Ex = 0 Then  'pas de cellule(s) modifiee(s)
                            Worksheets("local" ).Range("A" & ligTic1 & ":D" & ligTic1) = Worksheets("Export" ).Range("A" & cel.Row & ":D" & cel.Row).Value
                        Else
                            'alerte doublon(s) ticket
                            MsgBox "Attention Doublon Ticket: " & Ticket
                        End If
                    Else    'pas de ticket(s) memorise(s) avec cellule(s) modifiee(s)
                        Worksheets("local" ).Range("A" & ligTic1 & ":D" & ligTic1) = Worksheets("Export" ).Range("A" & cel.Row & ":D" & cel.Row).Value
                    End If
                End With
            ElseIf Nbre = 0 Then    'Tickets nouveaux
                'ajout nouveau(x) ticket(s)
                ligTic1 = derlig2 + 1
                .Range("A" & ligTic1 & ":D" & ligTic1 + ligFex - 2) = Worksheets("Export" ).Range("A" & cel.Row & ":D" & ligFex).Value
                .Range("H" & ligTic1 & ":M" & ligTic1 + ligFex - 2) = Worksheets("Export" ).Range("H" & cel.Row & ":M" & ligFex).Value
                Exit For
            Else
                MsgBox "Doublons " & cel & " dans fichier local.xlsm !!!!!!!", vbExclamation, "INFOS FICHIER LOCAL.XLSM"
                Exit Sub
            End If
        End With
    Next cel
   
    Application.EnableEvents = True
    Workbooks("Local.xlsm" ).Save
    Worksheets("Date" ).Activate
     
    MsgBox "Traitement fichier EXPORT.CSV vers LOCAL.XLSM terminé", vbInformation
     
End Sub
 
'utile pour mise au point et mise a jour onglet Mem_Modif_BCD si erreur(s)
'modification cellules BCD de l'onglet local
Sub affiche_onglet()
    'affiche onglet
    Worksheets("Mem_Modif_BCD" ).Visible = True
    'active evenements d'EXCEL
    Application.EnableEvents = True
End Sub

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed