Eclater une feuille en plusieurs et les recompiler en synthèse
11 réponses
mcl...
Bonjour Í tous,
Je vous explique mon problème.
J'ai une feuille qui contient environ 20 ou 40 000 lignes de données extraites d'une base de données.
J'utilise une procédure donnée par MichDenis qui me répartie les données de tous les vendeurs dans des feuilles Í leurs noms.
Avant d'éclater mes données, j'atoute une colonne commentaire.
Je souhaite recompiler toutes les feuilles des vendeurs en une seule mais qui cette fois contient les infos mises en commentaires.
En fait je voudrais éclater mes données en plusieurs feuilles et parfois j'ai besoin de les recompiler pour faire des bilans.
Autre solutions, de ma feuille principale, créer au tant de classeur que j'ai de nom de Vendeurs que je peux ensuite recompiler : plusieurs classeurs en un seul....
Je ne sais pas si je suis clair ?
Et la je suis bloquer.
2 bouts de code : A ) figer les volets de toutes les feuilles de calcul '------------------------------------------- Sub Figer_Volet_Toutes_Les_Feuilles() Dim Sh As Worksheet, Nom As String Application.ScreenUpdating = False Application.EnableEvents = False Nom = ActiveSheet.Name For Each Sh In Worksheets Sh.Select Sh.Rows("2:2").Select Sh.Range("A1").Select ActiveWindow.FreezePanes = True Next Worksheets(Nom).Activate Application.ScreenUpdating = False Application.EnableEvents = True End Sub '------------------------------------------- B ) effectuer une sélection de cellules Í partir d'une petite fenêtre. La sélection peut se faire directement avec la souris. '------------------------------------------- Sub tests() Dim Rg As Range On Error Resume Next Set Rg = Application.InputBox("Sélectionner la page de cellules", "Sélection", , , , , , 8) If Err <> 0 Then 'Si l'usager annule la fenêtre. Err = 0 Exit Sub End If If Not Rg Is Nothing Then 'le reste de ton code End If End Sub '------------------------------------------- MichD
2 bouts de code :
A ) figer les volets de toutes les feuilles de calcul
'-------------------------------------------
Sub Figer_Volet_Toutes_Les_Feuilles()
Dim Sh As Worksheet, Nom As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Nom = ActiveSheet.Name
For Each Sh In Worksheets
Sh.Select
Sh.Rows("2:2").Select
Sh.Range("A1").Select
ActiveWindow.FreezePanes = True
Next
Worksheets(Nom).Activate
Application.ScreenUpdating = False
Application.EnableEvents = True
End Sub
'-------------------------------------------
B ) effectuer une sélection de cellules Í partir d'une petite fenêtre.
La sélection peut se faire directement avec la souris.
'-------------------------------------------
Sub tests()
Dim Rg As Range
On Error Resume Next
Set Rg = Application.InputBox("Sélectionner la page de cellules",
"Sélection", , , , , , 8)
If Err <> 0 Then 'Si l'usager annule la fenêtre.
Err = 0
Exit Sub
End If
If Not Rg Is Nothing Then
'le reste de ton code
End If
End Sub
'-------------------------------------------
2 bouts de code : A ) figer les volets de toutes les feuilles de calcul '------------------------------------------- Sub Figer_Volet_Toutes_Les_Feuilles() Dim Sh As Worksheet, Nom As String Application.ScreenUpdating = False Application.EnableEvents = False Nom = ActiveSheet.Name For Each Sh In Worksheets Sh.Select Sh.Rows("2:2").Select Sh.Range("A1").Select ActiveWindow.FreezePanes = True Next Worksheets(Nom).Activate Application.ScreenUpdating = False Application.EnableEvents = True End Sub '------------------------------------------- B ) effectuer une sélection de cellules Í partir d'une petite fenêtre. La sélection peut se faire directement avec la souris. '------------------------------------------- Sub tests() Dim Rg As Range On Error Resume Next Set Rg = Application.InputBox("Sélectionner la page de cellules", "Sélection", , , , , , 8) If Err <> 0 Then 'Si l'usager annule la fenêtre. Err = 0 Exit Sub End If If Not Rg Is Nothing Then 'le reste de ton code End If End Sub '------------------------------------------- MichD
