Copie de données

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

Bonsoir,

Code non placé sous balises Code (donc beaucoup d'effort déjà demandé aux candidats intervenants... )

Code enregistré (et donc mal enregistré pour la partie rouge !)

Pas épuré du tout, pas indenté.

Autant de choses (et j'en passe) que je trouve dissuasives pour se pencher sur du code !

Ceci dit, je peux tout de même donner un conseil :

Aller dans l'Aide VBA : taper pastespecial

Tu verras proposer comme premier article : Worksheet.PasteSpecial, et comme suivant : Range.PasteSpecial.

La lecture devrait facilement te montrer que les syntaxes de ces deux méthodes sont assez différentes, et que tu as confondu les deux.

A partir de là il devrait être aisé d'apporter les rectifications nécessaires...

Cela ne suffira certes pas à améliorer le code et le réduire d'environ deux-tiers, tel qu'il devrait se présenter... mais en utilisant un peu (beaucoup) moins l'enregistreur, et un peu (beaucoup) plus l'Aide, on peut commencer à faire des progrès !

Cordialement.

Rechercher des sujets similaires à "copie donnees"