probleme dans la selection d'une page

[baud95]

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("C22").Select
Selection.AutoFill Destination:=Range("C2:BL2"), Type:=xlFillDefault
Range("C2:BL2").Select
Range("C33").Select
Selection.AutoFill Destination:=Range("C3:BL3"), Type:=xlFillDefault
Range("C3:BL3").Select
Range("C2:BL3").Select
Selection.Copy
Range("C44").Select
ActiveSheet.Paste
Range("C66").Select
ActiveSheet.Paste
Range("C88").Select
ActiveSheet.Paste
Range("C1010").Select
ActiveSheet.Paste
Range("C1212").Select
ActiveSheet.Paste
Range("C1414").Select
ActiveSheet.Paste
Range("C1616").Select
ActiveSheet.Paste
Range("C1818").Select
ActiveSheet.Paste
Range("C2020").Select
ActiveSheet.Paste
Range("C2222").Select
ActiveSheet.Paste
Range("C2424").Select
ActiveSheet.Paste
Range("C2626").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=20
Range("C2828").Select
ActiveSheet.Paste
Range("C3030").Select
ActiveSheet.Paste
Range("C3232").Select
ActiveSheet.Paste
Range("C3434").Select
ActiveSheet.Paste
Range("C3636").Select
ActiveSheet.Paste
Range("C3838").Select
ActiveSheet.Paste
Range("C4040").Select
ActiveSheet.Paste
Range("C4242").Select
ActiveSheet.Paste
Range("C4444").Select
ActiveSheet.Paste
Range("C4646").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=20
Range("C4848").Select
ActiveSheet.Paste
Range("C5050").Select
ActiveSheet.Paste
Range("C5252").Select
ActiveSheet.Paste
Range("C5454").Select
ActiveSheet.Paste
Range("C5656").Select
ActiveSheet.Paste
Range("C5858").Select
ActiveSheet.Paste
Range("C6060").Select
ActiveSheet.Paste
Range("C6262").Select
ActiveSheet.Paste
Range("C6464").Select
ActiveSheet.Paste
Range("C6666").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=23
Range("C6868").Select
ActiveSheet.Paste
Range("C7070").Select
ActiveSheet.Paste
Range("C7272").Select
ActiveSheet.Paste
Range("C7474").Select
ActiveSheet.Paste
Range("C7676").Select
ActiveSheet.Paste
Range("C7878").Select
ActiveSheet.Paste
Range("C8080").Select
ActiveSheet.Paste
Range("C8282").Select
ActiveSheet.Paste
Range("C8484").Select
ActiveSheet.Paste
Range("C8686").Select
ActiveSheet.Paste
Range("C8888").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("C22").Select
Application.CutCopyMode = False
Sheets("juin").Select
End Sub



merci pour le temps passé à me depatouiller

cordialement

david

 

[Sly le globe trotter]

Re : probleme dans la selection d'une page

Salut baud95,

dur dur de t'aider avec le code sans le fichier... Peux-tu le joindre pour aller plus vite.

Sly

 

[baud95]

Re : probleme dans la selection d'une page

desolé mais le fichier pèse 20 MO donc ca va pas être possible et meme en faisant un tableur allègé il est trop lourd.

Je ne sais pas comment m'y prendre

merci quand meme

 

[Sly le globe trotter]

Re : probleme dans la selection d'une page

Tu n'as pas la possibilité de supprimer tous les onglets sauf ceux mentionnés dans ton code ?
Sly

 

[baud95]

Re : probleme dans la selection d'une page

meme comme ca il est largement trop lourd... je suis navré

 

[Sly le globe trotter]

Re : probleme dans la selection d'une page

C'est pour toi...