Pb VBA
Résolu
Argentomaouss
-
eriiic Messages postés 25847 Date d'inscription Statut Contributeur Dernière intervention -
eriiic Messages postés 25847 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
Soit un classeur Excel97 dont le premier onglet sert de base de données que j'enrichis au fur et à mesure.
Lorsque je clique sur les onglets suivants, ceux-ci se mettent automatiquement à jour des données que j'ai ajoutées sur l'onglet "Base" au moyen de la macro suivante :
--------------
Private Sub tri()
Dim a, i, r
Application.ScreenUpdating = False
For i = 2 To Sheets.Count
Sheets(i).UsedRange.ClearContents
Next
With Sheets("Base").UsedRange
For i = 2 To .Rows.Count
Select Case LCase(.Cells(i, 3).Value)
Case "poste1": a = 2: r = report(a, i)
Case Else: a = 3: r = report(a, i)
End Select
Next
End With
Application.ScreenUpdating = True
End Sub
Private Function report(a, i)
Dim c, j
c = 1
With Sheets("Base").UsedRange
For j = .Column To .Columns.Count
Sheets(a).Cells(65536, 1).End(xlUp).Offset(c, j - 1).Value = Sheets("Base").Cells(i, j).Value
c = 0
Next
End With
End Function
---------------
Sur les onglets suivants (mis à jour automatiquement) figurent des formules, sur des cellules qui théoriquement ne devraient pas être affectées par la mise à jour automatique.
Mon problème, c'est que lors de la mise à jour, ces formules sont effacées par la macro.
Comment puis-je faire pour que les formules pré-saisies ne disparaissent pas ?
Merci d'avance pour le temps que vous consacrerez à mon problème.
Soit un classeur Excel97 dont le premier onglet sert de base de données que j'enrichis au fur et à mesure.
Lorsque je clique sur les onglets suivants, ceux-ci se mettent automatiquement à jour des données que j'ai ajoutées sur l'onglet "Base" au moyen de la macro suivante :
--------------
Private Sub tri()
Dim a, i, r
Application.ScreenUpdating = False
For i = 2 To Sheets.Count
Sheets(i).UsedRange.ClearContents
Next
With Sheets("Base").UsedRange
For i = 2 To .Rows.Count
Select Case LCase(.Cells(i, 3).Value)
Case "poste1": a = 2: r = report(a, i)
Case Else: a = 3: r = report(a, i)
End Select
Next
End With
Application.ScreenUpdating = True
End Sub
Private Function report(a, i)
Dim c, j
c = 1
With Sheets("Base").UsedRange
For j = .Column To .Columns.Count
Sheets(a).Cells(65536, 1).End(xlUp).Offset(c, j - 1).Value = Sheets("Base").Cells(i, j).Value
c = 0
Next
End With
End Function
---------------
Sur les onglets suivants (mis à jour automatiquement) figurent des formules, sur des cellules qui théoriquement ne devraient pas être affectées par la mise à jour automatique.
Mon problème, c'est que lors de la mise à jour, ces formules sont effacées par la macro.
Comment puis-je faire pour que les formules pré-saisies ne disparaissent pas ?
Merci d'avance pour le temps que vous consacrerez à mon problème.
6 réponses
Bonjour,
Tu pourrais utiliser la propriété hasformula de l'objet range et renvoyant un booléan
Bon WE
Michel
Tu pourrais utiliser la propriété hasformula de l'objet range et renvoyant un booléan
Bon WE
Michel
Bonjour,
For i = 2 To Sheets.Count
Sheets(i).UsedRange.ClearContents
Next
Sur chaque feuille sauf la 1ère tu effaces tout, normal que tu n'aies plus rien.
Défini plutôt la zone que tu veux nettoyer avec .range() à la place de .usedrange
eric
For i = 2 To Sheets.Count
Sheets(i).UsedRange.ClearContents
Next
Sur chaque feuille sauf la 1ère tu effaces tout, normal que tu n'aies plus rien.
Défini plutôt la zone que tu veux nettoyer avec .range() à la place de .usedrange
eric
Merci beaucoup,
J'ai redéfini la zone à nettoyer de la façon suivante :
______________________
Private Sub tri()
Dim a, i, r
Application.ScreenUpdating = False
For i = 2 To Sheets.Count
Sheets(i).Range("B2").CurrentRegion.ClearContents
Next
With Sheets("Base").UsedRange
For i = 2 To .Rows.Count
Select Case LCase(.Cells(i, 3).Value)
Case "poste1": a = 2: r = report(a, i)
Case "poste2": a = 3: r = report(a, i)
Case Else: a = 4: r = report(a, i)
End Select
Next
End With
Application.ScreenUpdating = True
End Sub
Private Function report(a, i)
Dim c, j
c = 1
With Sheets("Base").UsedRange
For j = .Column To .Columns.Count
Sheets(a).Cells(65536, 1).End(xlUp).Offset(c, j - 1).Value = Sheets("Base").Cells(i, j).Value
c = 0
Next
End With
End Function
__________________
Comment faire pour que la ligne de titre qui figure sur la base soit recopiée automatiquement sur tous les autres onglets. C'est le seul problème qui me reste...
Merci d'avance encore une fois.
J'ai redéfini la zone à nettoyer de la façon suivante :
______________________
Private Sub tri()
Dim a, i, r
Application.ScreenUpdating = False
For i = 2 To Sheets.Count
Sheets(i).Range("B2").CurrentRegion.ClearContents
Next
With Sheets("Base").UsedRange
For i = 2 To .Rows.Count
Select Case LCase(.Cells(i, 3).Value)
Case "poste1": a = 2: r = report(a, i)
Case "poste2": a = 3: r = report(a, i)
Case Else: a = 4: r = report(a, i)
End Select
Next
End With
Application.ScreenUpdating = True
End Sub
Private Function report(a, i)
Dim c, j
c = 1
With Sheets("Base").UsedRange
For j = .Column To .Columns.Count
Sheets(a).Cells(65536, 1).End(xlUp).Offset(c, j - 1).Value = Sheets("Base").Cells(i, j).Value
c = 0
Next
End With
End Function
__________________
Comment faire pour que la ligne de titre qui figure sur la base soit recopiée automatiquement sur tous les autres onglets. C'est le seul problème qui me reste...
Merci d'avance encore une fois.
Avec le presse-papier, au début tu copie la 1ère ligne et comme il ne te sert pas dans ta fonction
chaque entrée dans une nouvelle feuille tu sélectionne A1 et Past.
A+
chaque entrée dans une nouvelle feuille tu sélectionne A1 et Past.
A+
Bonjour,
tu ajoutes à la fin :
For i = 2 To Sheets.Count
Worksheets("Base").Rows("1:1").Copy Destination:=Worksheets(i).Rows("1:1")
Next
eric
tu ajoutes à la fin :
For i = 2 To Sheets.Count
Worksheets("Base").Rows("1:1").Copy Destination:=Worksheets(i).Rows("1:1")
Next
eric
Bonjour,
Merci pour le tuyau.
Cependant je ne sais pas où ajouter ce que tu m'indiques. J'ai essayé d'inclure ça un peu partout vers la fin mais, le plus souvent, la macro tourne (curseur en sablier) mais n'affiche jamais rien et je finis par faire un Ctrl+Alt+Suppr et "Fin de tâche" pour Excel.
Peux-tu m'indiquer précisément où je dois inclure cette "phrase" SVP ?
En tous cas merci de t'être intéressé à mon cas. J'en profite également pour remercier tous ceux qui ont donné des pistes.
Merci pour le tuyau.
Cependant je ne sais pas où ajouter ce que tu m'indiques. J'ai essayé d'inclure ça un peu partout vers la fin mais, le plus souvent, la macro tourne (curseur en sablier) mais n'affiche jamais rien et je finis par faire un Ctrl+Alt+Suppr et "Fin de tâche" pour Excel.
Peux-tu m'indiquer précisément où je dois inclure cette "phrase" SVP ?
En tous cas merci de t'être intéressé à mon cas. J'en profite également pour remercier tous ceux qui ont donné des pistes.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Une solution parmi d'autre...
Private Sub tri()
Dim a, i, r
Application.ScreenUpdating = False
For i = 2 To Sheets.Count
Sheets(i).UsedRange.ClearContents
Sheets("Base").Select: Rows("1:1").Select
Selection.Copy
Sheets(i).Select
ActiveSheet.Rows("1:1").Select
ActiveSheet.Paste
MAIS LA SOLUTION DE eriiic EST PLUS COURTE
'Worksheets("Base").Rows("1:1").Copy Destination:=Worksheets(i).Rows("1:1")
Next
.........
Voilà ma macro définitive, il ne me restera qu'à l'adapter à une base beaucoup plus grosse que ma base test...
Private Sub tri()
Dim a, i, r
Application.ScreenUpdating = False
For i = 2 To Sheets.Count
Sheets(i).Range("B2").CurrentRegion.ClearContents
Next
With Sheets("Base").UsedRange
For i = 2 To .Rows.Count
Select Case LCase(.Cells(i, 3).Value)
Case "poste1": a = 2: r = report(a, i)
Case "poste2": a = 3: r = report(a, i)
Case Else: a = 4: r = report(a, i)
End Select
Next
For i = 2 To Sheets.Count
Sheets(i).Rows("1:1").ClearContents
Worksheets("Base").Rows("1:1").Copy Destination:=Worksheets(i).Rows("1:1")
Next
End With
Application.ScreenUpdating = True
End Sub
Private Function report(a, i)
Dim c, j
c = 1
With Sheets("Base").UsedRange
For j = .Column To .Columns.Count
Sheets(a).Cells(65536, 1).End(xlUp).Offset(c, j - 1).Value = Sheets("Base").Cells(i, j).Value
c = 0
Next
End With
End Function
Tout ça fonctionne grâce à vous.
Soyez tous remerciés. Je reviendrai sur ce forum.
A la prochaine donc et encore merci
Private Sub tri()
Dim a, i, r
Application.ScreenUpdating = False
For i = 2 To Sheets.Count
Sheets(i).Range("B2").CurrentRegion.ClearContents
Next
With Sheets("Base").UsedRange
For i = 2 To .Rows.Count
Select Case LCase(.Cells(i, 3).Value)
Case "poste1": a = 2: r = report(a, i)
Case "poste2": a = 3: r = report(a, i)
Case Else: a = 4: r = report(a, i)
End Select
Next
For i = 2 To Sheets.Count
Sheets(i).Rows("1:1").ClearContents
Worksheets("Base").Rows("1:1").Copy Destination:=Worksheets(i).Rows("1:1")
Next
End With
Application.ScreenUpdating = True
End Sub
Private Function report(a, i)
Dim c, j
c = 1
With Sheets("Base").UsedRange
For j = .Column To .Columns.Count
Sheets(a).Cells(65536, 1).End(xlUp).Offset(c, j - 1).Value = Sheets("Base").Cells(i, j).Value
c = 0
Next
End With
End Function
Tout ça fonctionne grâce à vous.
Soyez tous remerciés. Je reviendrai sur ce forum.
A la prochaine donc et encore merci
