probleme dans la selection d'une page

baud95

XLDnaute Nouveau
Bonjour à tous et merci pour votre aide

Je suis en train de travailler sur un projet de planning.

Vous m'avez beaucoup aidé jusqu'à maintenant et j'ai pu compilé deux macros faites par vous.
Désormais je rajoute quelques formules (style copier coller) et là le programme bloque pouvait me dire pourquoi ?

Merci beaucoup

Voici ma macro. elle bloque à partir du milieu à la formule Sheets ("06").Select

Sub juin()
ChDir "F:\service 2010"
Workbooks.Open Filename:="F:\service 2010\juin.xml"
Cells.Select
Selection.Copy
Workbooks("planning 2010.xls").Activate
Sheets("e06").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.DisplayAlerts = False
Workbooks("juin.xml").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
Cells.Select
Sheets("O6").Select
Range("C2:D2").Select
Selection.AutoFill Destination:=Range("C2:BL2"), Type:=xlFillDefault
Range("C2:BL2").Select
Range("C3:D3").Select
Selection.AutoFill Destination:=Range("C3:BL3"), Type:=xlFillDefault
Range("C3:BL3").Select
Range("C2:BL3").Select
Selection.Copy
Range("C4:D4").Select
ActiveSheet.Paste
Range("C6:D6").Select
ActiveSheet.Paste
Range("C8:D8").Select
ActiveSheet.Paste
Range("C10:D10").Select
ActiveSheet.Paste
Range("C12:D12").Select
ActiveSheet.Paste
Range("C14:D14").Select
ActiveSheet.Paste
Range("C16:D16").Select
ActiveSheet.Paste
Range("C18:D18").Select
ActiveSheet.Paste
Range("C20:D20").Select
ActiveSheet.Paste
Range("C22:D22").Select
ActiveSheet.Paste
Range("C24:D24").Select
ActiveSheet.Paste
Range("C26:D26").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=20
Range("C28:D28").Select
ActiveSheet.Paste
Range("C30:D30").Select
ActiveSheet.Paste
Range("C32:D32").Select
ActiveSheet.Paste
Range("C34:D34").Select
ActiveSheet.Paste
Range("C36:D36").Select
ActiveSheet.Paste
Range("C38:D38").Select
ActiveSheet.Paste
Range("C40:D40").Select
ActiveSheet.Paste
Range("C42:D42").Select
ActiveSheet.Paste
Range("C44:D44").Select
ActiveSheet.Paste
Range("C46:D46").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=20
Range("C48:D48").Select
ActiveSheet.Paste
Range("C50:D50").Select
ActiveSheet.Paste
Range("C52:D52").Select
ActiveSheet.Paste
Range("C54:D54").Select
ActiveSheet.Paste
Range("C56:D56").Select
ActiveSheet.Paste
Range("C58:D58").Select
ActiveSheet.Paste
Range("C60:D60").Select
ActiveSheet.Paste
Range("C62:D62").Select
ActiveSheet.Paste
Range("C64:D64").Select
ActiveSheet.Paste
Range("C66:D66").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=23
Range("C68:D68").Select
ActiveSheet.Paste
Range("C70:D70").Select
ActiveSheet.Paste
Range("C72:D72").Select
ActiveSheet.Paste
Range("C74:D74").Select
ActiveSheet.Paste
Range("C76:D76").Select
ActiveSheet.Paste
Range("C78:D78").Select
ActiveSheet.Paste
Range("C80:D80").Select
ActiveSheet.Paste
Range("C82:D82").Select
ActiveSheet.Paste
Range("C84:D84").Select
ActiveSheet.Paste
Range("C86:D86").Select
ActiveSheet.Paste
Range("C88:D88").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=9
ActiveWindow.ScrollRow = 72
ActiveWindow.ScrollRow = 56
ActiveWindow.ScrollRow = 35
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 1
Range("C2:D2").Select
Application.CutCopyMode = False
Sheets("juin").Select
End Sub



merci pour le temps passé à me depatouiller

cordialement

david
 

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 792
Membres
101 817
dernier inscrit
carvajal