Pb VBA

Résolu/Fermé
Argentomaouss - 16 mai 2008 à 21:57
eriiic Messages postés 24603 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 15 décembre 2024 - 18 mai 2008 à 21:11
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.

6 réponses

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
17 mai 2008 à 09:45
Bonjour,

Tu pourrais utiliser la propriété hasformula de l'objet range et renvoyant un booléan

Bon WE

Michel
0
eriiic Messages postés 24603 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 15 décembre 2024 7 247
17 mai 2008 à 11:50
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
0
Argentomaouss
17 mai 2008 à 22:52
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.
0
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
18 mai 2008 à 02:27
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+
0
eriiic Messages postés 24603 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 15 décembre 2024 7 247
18 mai 2008 à 10:36
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
0
Argentomaouss
18 mai 2008 à 19:14
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.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
18 mai 2008 à 19:42
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 

.........


0
Argentomaouss
18 mai 2008 à 20:40
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
0
eriiic Messages postés 24603 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 15 décembre 2024 7 247
18 mai 2008 à 21:11
et 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
0