copie des données

[pimous2403]

Bonsoir,

Dans le cadre de mon travail, j'ai créé un fichier copiant différentes données par l'intermédiaire de macros dans divers fichiers excel. La première partie du code, en noir, fonctionne parfaitement. Quand je réalise la même chose pour un autre fichier, la deuxième partie, en rouge, ne fonctionne pas et un bug se produit. Novice, j'ai besoin de votre aide.

Merci


Private Sub Workbook_Open()


'ouverture UCE

NomFichier = ActiveWorkbook.Name
datefic = Right(NomFichier, Len(NomFichier) - 16)
datefic = Left(datefic, Len(datefic) - 5)
Set TDB = ActiveWorkbook
Set UCE = Workbooks.Open("\\bra\dir_d\SAT-Unités B\Recueil UCE\Watt\" + datefic + "\Recueil CE Mensuel *.xlsx")
Set ACC = Workbooks.Open("S:\DSET – Sécurité exploitation\Sinistralité 2017\Watt\SUIVI ACCIDENT - WATT - 2017.xlsx""

'copie avances

UCE.Sheets(9).Select
Range("B8:T563").Select
Selection.Copy
Workbooks(NomFichier).Activate

ActiveWorkbook.Sheets(4).Select
Range("C8").Select
ActiveSheet.Paste

'retraitement somme sans lia


i = 8
Do While Cells(i, 20) <> ""
Cells(i, 20).FormulaR1C1 = "=SUM(RC[-15]:RC[-6])+SUM(RC[-3]:RC[-1])"
i = i + 1
Loop


'tri total avances sans lia


Cells(i - 1, 3).MergeCells = False
Range("t7:t" & i - 1).Select
ActiveWorkbook.Worksheets("AVANCES ").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("AVANCES ").Sort.SortFields.Add Key:= _
Range("t7"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("AVANCES ").Sort
.SetRange Range("C8:u" & i - 1)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'copie avances/retard lignes

UCE.Activate
UCE.Sheets(1).Select
Range("B6:k18").Select
Selection.Copy
Workbooks(NomFichier).Activate

ActiveWorkbook.Sheets(5).Select
Range("B6").Select
ActiveSheet.Paste

'copie avance


UCE.Activate
UCE.Sheets(11).Select
Range("B10:I563").Select
Selection.Copy
Workbooks(NomFichier).Activate

ActiveWorkbook.Sheets(6).Select
Range("B10").Select
ActiveSheet.Paste

' tribattement Macro


Range("B403:C403").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
ActiveWorkbook.Worksheets("BATTEMENT").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("BATTEMENT").AutoFilter.Sort.SortFields.Add Key:= _
Range("D9

428"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("BATTEMENT").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'fermeture CE

NomUCE = UCE.Name
Application.CutCopyMode = False
Workbooks(NomUCE).Close SaveChanges:=False
Application.CutCopyMode = True

'copie suivi accidentologie
'ouverture ACC


ACC.Activate
ACC.Sheets("data").Select
Range("B4:N21").Select
Selection.Copy
Workbooks(NomFichier).Activate

ActiveWorkbook.Sheets(6).Select
Range("B6").Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ACC.Activate
ACC.Sheets("data").Select
Range("Q4:S21").Select
Selection.Copy
Workbooks(NomFichier).Activate

ActiveWorkbook.Sheets(6).Select
Range("B135").Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ACC.Activate
ACC.Sheets("data").Select
Range("U4:U21").Select
Selection.Copy
Workbooks(NomFichier).Activate

ActiveWorkbook.Sheets(6).Select
Range("B131").Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

NomACC = ACC.Name
Application.CutCopyMode = False
Workbooks(NomUCE).Close SaveChanges:=False
Application.CutCopyMode = True


' ouverture de TBD

ActiveWorkbook.Worksheets("TDB").Activate


End Sub

 

[herve62]

Bonjour
En laissant le fichier excel .. cela irait mieux ; on pourrait voir ou ça plante
Apparemment tu es sur un serveur , mais on peut adapter la source chez nous
A suivre .... attente fichier

 

[pimous2403]

Bonjour
En laissant le fichier excel .. cela irait mieux ; on pourrait voir ou ça plante
Apparemment tu es sur un serveur , mais on peut adapter la source chez nous
A suivre .... attente fichier

Bonsoir

Je vous envoie une copie du fichier
Merci pour votre aide.

 

[herve62]

Bonsoir
Beau graphisme pour excel !! maintenant reste à analyser (j'ai vu ou cela se passait) , cela va prendre un peu de temps .. mais bon à mon avis il va y avoir des Barbatrucs très dispo, qui vont me relayer
Je ne peux pas te consacrer du temps avant semaine prochaine