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 2").Select
Selection.AutoFill Destination:=Range("C2:BL2"), Type:=xlFillDefault
Range("C2:BL2").Select
Range("C3 3").Select
Selection.AutoFill Destination:=Range("C3:BL3"), Type:=xlFillDefault
Range("C3:BL3").Select
Range("C2:BL3").Select
Selection.Copy
Range("C4 4").Select
ActiveSheet.Paste
Range("C6 6").Select
ActiveSheet.Paste
Range("C8 8").Select
ActiveSheet.Paste
Range("C10 10").Select
ActiveSheet.Paste
Range("C12 12").Select
ActiveSheet.Paste
Range("C14 14").Select
ActiveSheet.Paste
Range("C16 16").Select
ActiveSheet.Paste
Range("C18 18").Select
ActiveSheet.Paste
Range("C20 20").Select
ActiveSheet.Paste
Range("C22 22").Select
ActiveSheet.Paste
Range("C24 24").Select
ActiveSheet.Paste
Range("C26 26").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=20
Range("C28 28").Select
ActiveSheet.Paste
Range("C30 30").Select
ActiveSheet.Paste
Range("C32 32").Select
ActiveSheet.Paste
Range("C34 34").Select
ActiveSheet.Paste
Range("C36 36").Select
ActiveSheet.Paste
Range("C38 38").Select
ActiveSheet.Paste
Range("C40 40").Select
ActiveSheet.Paste
Range("C42 42").Select
ActiveSheet.Paste
Range("C44 44").Select
ActiveSheet.Paste
Range("C46 46").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=20
Range("C48 48").Select
ActiveSheet.Paste
Range("C50 50").Select
ActiveSheet.Paste
Range("C52 52").Select
ActiveSheet.Paste
Range("C54 54").Select
ActiveSheet.Paste
Range("C56 56").Select
ActiveSheet.Paste
Range("C58 58").Select
ActiveSheet.Paste
Range("C60 60").Select
ActiveSheet.Paste
Range("C62 62").Select
ActiveSheet.Paste
Range("C64 64").Select
ActiveSheet.Paste
Range("C66 66").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=23
Range("C68 68").Select
ActiveSheet.Paste
Range("C70 70").Select
ActiveSheet.Paste
Range("C72 72").Select
ActiveSheet.Paste
Range("C74 74").Select
ActiveSheet.Paste
Range("C76 76").Select
ActiveSheet.Paste
Range("C78 78").Select
ActiveSheet.Paste
Range("C80 80").Select
ActiveSheet.Paste
Range("C82 82").Select
ActiveSheet.Paste
Range("C84 84").Select
ActiveSheet.Paste
Range("C86 86").Select
ActiveSheet.Paste
Range("C88 88").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 2").Select
Application.CutCopyMode = False
Sheets("juin").Select
End Sub
merci pour le temps passé à me depatouiller
cordialement
david
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
Selection.AutoFill Destination:=Range("C2:BL2"), Type:=xlFillDefault
Range("C2:BL2").Select
Range("C3
Selection.AutoFill Destination:=Range("C3:BL3"), Type:=xlFillDefault
Range("C3:BL3").Select
Range("C2:BL3").Select
Selection.Copy
Range("C4
ActiveSheet.Paste
Range("C6
ActiveSheet.Paste
Range("C8
ActiveSheet.Paste
Range("C10
ActiveSheet.Paste
Range("C12
ActiveSheet.Paste
Range("C14
ActiveSheet.Paste
Range("C16
ActiveSheet.Paste
Range("C18
ActiveSheet.Paste
Range("C20
ActiveSheet.Paste
Range("C22
ActiveSheet.Paste
Range("C24
ActiveSheet.Paste
Range("C26
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=20
Range("C28
ActiveSheet.Paste
Range("C30
ActiveSheet.Paste
Range("C32
ActiveSheet.Paste
Range("C34
ActiveSheet.Paste
Range("C36
ActiveSheet.Paste
Range("C38
ActiveSheet.Paste
Range("C40
ActiveSheet.Paste
Range("C42
ActiveSheet.Paste
Range("C44
ActiveSheet.Paste
Range("C46
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=20
Range("C48
ActiveSheet.Paste
Range("C50
ActiveSheet.Paste
Range("C52
ActiveSheet.Paste
Range("C54
ActiveSheet.Paste
Range("C56
ActiveSheet.Paste
Range("C58
ActiveSheet.Paste
Range("C60
ActiveSheet.Paste
Range("C62
ActiveSheet.Paste
Range("C64
ActiveSheet.Paste
Range("C66
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=23
Range("C68
ActiveSheet.Paste
Range("C70
ActiveSheet.Paste
Range("C72
ActiveSheet.Paste
Range("C74
ActiveSheet.Paste
Range("C76
ActiveSheet.Paste
Range("C78
ActiveSheet.Paste
Range("C80
ActiveSheet.Paste
Range("C82
ActiveSheet.Paste
Range("C84
ActiveSheet.Paste
Range("C86
ActiveSheet.Paste
Range("C88
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
Application.CutCopyMode = False
Sheets("juin").Select
End Sub
merci pour le temps passé à me depatouiller
cordialement
david