Pb VBA
Résolu
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.
Configuration: Windows XP Firefox 2.0.0.12
6 réponses
-
ContributeurBonjour,
Tu pourrais utiliser la propriété hasformula de l'objet range et renvoyant un booléan
Bon WE
Michel -
ContributeurBonjour,
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.
-
-
ContributeurAvec 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+ -
ContributeurBonjour,
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.
-
-
ContributeurUne 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
-
-
Contributeuret bien tu as fini par trouver... ;-)
Tu aurais pu le mettre aussi après le endwith pour une question de clarté.
Le Sheets(i).Rows("1:1").ClearContents doit être inutile puisque tu colles par dessus.
Et tu as mis en résolu en plus, formidable :-)
Bonne continuation
eric
