Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
1401 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  [VBA] mise à jour automatique d'une cellule

 



 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

[VBA] mise à jour automatique d'une cellule

n°2196435
6delirium8
Posté le 03-07-2013 à 17:10:37  profilanswer
 

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

mood
Publicité
Posté le 03-07-2013 à 17:10:37  profilanswer
 

n°2196440
mmarle
Posté le 03-07-2013 à 17:42:17  profilanswer
 

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.

n°2196479
6delirium8
Posté le 04-07-2013 à 10:46:30  profilanswer
 

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 !

n°2252883
neyney25
Posté le 11-03-2015 à 00:13:20  profilanswer
 

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


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  [VBA] mise à jour automatique d'une cellule

 

Sujets relatifs
Problème de comparaison textbox et cellule active[VBA] Enregistrement format spécifique
VBA et chaine de caractères[Resolu] [VBA] Impression Fichier .pdf (Hyperliens)
Faire interpréter par jquery un contenu html mis à jour[VBA] Excel 2010: remplacer FileSearch de Excel 2003
Bd Access, champs liés à la source Excel avec VBA génération automatique d'un emploie du temps_windev
[vba] numéro de la page de la cellule sélectionnée 
Plus de sujets relatifs à : [VBA] mise à jour automatique d'une cellule


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR