meme macro mais avec un onglet different

baud95

XLDnaute Nouveau
Bonjour à tous et merci pour votre aide.

Afin de me simplifier la vie, j'ai ecrit une macro (j'avoue j'ai été très aidé par le forum).

Seul problème, je souhaiterai que ma macro change en fonction du nom de classeur
ex sur mon classeur j'ai des onglets de janvier à février et effectifs01 à effectifs12 en relation les uns avec les autres


en faite je souhaiterais ecrire la meme macro pour tous mes onglets mais qu'elle change en fonction du nom de l'onglet

ma macro est la suivante pour l'onglet "janvier":
Sub janvier()
Sheets("effectifs01").Visible = True
Sheets("effectifs01").Select
ChDir "F:\service 2010"
Workbooks.Open Filename:="F:\service 2010\janvier.xls"
Cells.Select
Selection.Copy
ActiveWindow.WindowState = xlMinimized
ActiveWindow.WindowState = xlMaximized
Cells.Select
ActiveSheet.Paste
ActiveWindow.WindowState = xlMinimized
Windows("janvier.xls").Activate
ActiveWindow.WindowState = xlMaximized
Application.DisplayAlerts = False
Workbooks("janvier.xls").Close SaveChange = False
Application.DisplayAlerts = True
Dim ligne As Long
Dim calMode As XlCalculation
'Pour aller plus vite
On Error GoTo FinInsertionLignes
With Application
calMode = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlManual
End With
With ActiveSheet
For ligne = .Cells(.Rows.Count, 1).End(xlUp).Row To 8 Step -1

'If .MergeCells Then .UnMerge
If Not .Cells(ligne, 1).Offset(-1).MergeCells And .Cells(ligne, 1).Offset(-1) <> "Nom et Prénom" Then
.Cells(ligne, 1).EntireRow.Insert xlShiftDown
.Cells(ligne - 1, 1).Resize(2, 1).Merge
.Cells(ligne - 1, 2).Resize(2, 1).Merge
Else
ligne = ligne - 1
End If

Next ligne
End With
'Rétablir les propriétés de départ de l'application
FinInsertionLignes:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = calMode
End With
Dim I As Byte
For Each Cel In Range("C10:BL150")
If Cel.MergeCells And Cel.Row Mod 2 = 0 Then
I = Cel.MergeArea.Cells.Count
Cel.UnMerge
Cel.Resize(1, I).Value = Cel.Value
End If
Next Cel
Sheets("effectifs01").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("janvier").Select

End Sub


Merci pour votre aide

Cordialement
David
 

Discussions similaires

Statistiques des forums

Discussions
312 492
Messages
2 088 925
Membres
103 984
dernier inscrit
maliko67