tries de données avec macro

J

juju

Guest
Bonjour,

j'aimerais trier des données a partir d'une macro.
les données doivent etre afficheés sur la page suivant le mois de l'année.

Voici ci-dessous un exemple d'une maro qui réalise cette opération, mais ds mon application g plus de données a transmettre sur les autres pages (voir fichier exemple).

mon problème est que je n'arrive pas à adapter la macro a mon application.

si vous aviez une petite idée...

merci d'avance


Sub transfertVentilation()


'
' Macro1 Macro
' Macro enregistrée le 08/04/2005 par massey-jul
'
' Touche de raccourci du clavier: Ctrl+a
'mise en forme en ordre croissant des valeurs suivant la date'

Columns('B:C').Select
Selection.Sort Key1:=Range('B2'), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

'fin de la mise en forme'

'Transfert des données vers les autres feuilles de calculs'

Dim MyDate As Long, MyMonth As Byte
Dim i As Integer, Lig As Integer, Mois As Byte

Application.ScreenUpdating = False
'Effacement des données en place
For i = 2 To 13
If i <= Sheets.Count Then ' Exit Sub
Lig = Sheets(i).Range('B65536').End(xlUp).Row + 1
Range(Sheets(i).Cells(2, 2), Sheets(i).Cells(Lig, 3)).ClearContents
End If
Next i
'Transfert des nouvelles données
Lig = Sheets('Base').Range('B65536').End(xlUp).Row
For Mois = 1 To 12
For i = 2 To Lig
MyDate = Sheets('Base').Cells(i, 2) ' Attribue une date.
MyMonth = Month(MyDate)
If MyMonth = Mois Then
Sheets(Mois + 1).Range('B65000').End(xlUp).EntireRow.Range('B2:C2').Value _
= Sheets('Base').Cells(i, 2).EntireRow.Range('B1:C1').Value
End If
Next i
Next Mois
Application.ScreenUpdating = True




End Sub
Sub Effacement()
Dim i As Byte, Lig As Integer
Application.ScreenUpdating = False
For i = 2 To 13
If i > Sheets.Count - 1 Then Exit Sub
Lig = Sheets(i).Range('B65536').End(xlUp).Row + 1
Range(Sheets(i).Cells(2, 2), Sheets(i).Cells(Lig, 3)).ClearContents
Next i
Application.ScreenUpdating = True
End Sub [file name=reorganisationexe.zip size=24159]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/reorganisationexe.zip[/file]
 

Pièces jointes

  • reorganisationexe.zip
    23.6 KB · Affichages: 23
J

juju

Guest
trier des données avec macro

juju écrit:
Bonjour,

j'aimerais trier des données a partir d'une macro.
les données doivent etre afficheés sur la page suivant le mois de l'année.

Voici ci-dessous un exemple d'une maro qui réalise cette opération, mais ds mon application g plus de données a transmettre sur les autres pages (voir fichier exemple).

mon problème est que je n'arrive pas à adapter la macro a mon application.

si vous aviez une petite idée...

merci d'avance


Sub transfertVentilation()


'
' Macro1 Macro
' Macro enregistrée le 08/04/2005 par massey-jul
'
' Touche de raccourci du clavier: Ctrl+a
'mise en forme en ordre croissant des valeurs suivant la date'

Columns('B:C').Select
Selection.Sort Key1:=Range('B2'), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

'fin de la mise en forme'

'Transfert des données vers les autres feuilles de calculs'

Dim MyDate As Long, MyMonth As Byte
Dim i As Integer, Lig As Integer, Mois As Byte

Application.ScreenUpdating = False
'Effacement des données en place
For i = 2 To 13
If i <= Sheets.Count Then ' Exit Sub
Lig = Sheets(i).Range('B65536').End(xlUp).Row + 1
Range(Sheets(i).Cells(2, 2), Sheets(i).Cells(Lig, 3)).ClearContents
End If
Next i
'Transfert des nouvelles données
Lig = Sheets('Base').Range('B65536').End(xlUp).Row
For Mois = 1 To 12
For i = 2 To Lig
MyDate = Sheets('Base').Cells(i, 2) ' Attribue une date.
MyMonth = Month(MyDate)
If MyMonth = Mois Then
Sheets(Mois + 1).Range('B65000').End(xlUp).EntireRow.Range('B2:C2').Value _
= Sheets('Base').Cells(i, 2).EntireRow.Range('B1:C1').Value
End If
Next i
Next Mois
Application.ScreenUpdating = True




End Sub
Sub Effacement()
Dim i As Byte, Lig As Integer
Application.ScreenUpdating = False
For i = 2 To 13
If i > Sheets.Count - 1 Then Exit Sub
Lig = Sheets(i).Range('B65536').End(xlUp).Row + 1
Range(Sheets(i).Cells(2, 2), Sheets(i).Cells(Lig, 3)).ClearContents
Next i
Application.ScreenUpdating = True
End Sub [file name=reorganisationexe.zip size=24159]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/reorganisationexe.zip[/file]
[file name=reorganisationexe_20050411154232.zip size=24159]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/reorganisationexe_20050411154232.zip[/file]
 

Pièces jointes

  • reorganisationexe_20050411154232.zip
    23.6 KB · Affichages: 16

Discussions similaires

Réponses
11
Affichages
419

Statistiques des forums

Discussions
313 032
Messages
2 094 576
Membres
106 054
dernier inscrit
Mohajer