mise à jour automatique d'une cellule [VBA] - VB/VBA/VBS - Programmation
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 :
|
Ceci devrait aller, à tester car je ne suis pas devant le PC mais en vacances!
Tiens moi au courant.
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 !
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
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