probleme de copier coller

[tony]

bonjour le forum,
Pouvez vous m'aider ou se trouve le probleme de ma progrmmation ci joint
par avance merci.

Sub tony()

' tony Macro

Application.ScreenUpdating = False

r = MsgBox('vous voulez importer les Relevés de Prix ? ', vbYesNo)
If r = vbYes Then

With ActiveWorkbook
.Sheets('TARIFAIRE').Unprotect
End With

'boucle pour ouvrir les fichiers releves magasins afin de les copier
For T = 10 To 36
If IsEmpty(Cells(T, 93)) Then GoTo ligne600
On Error GoTo ligne600
Workbooks.Open Filename:=ActiveWorkbook.Sheets(1).Cells(T, 93)


'boucle pour copier les releves dans des plages de colonnes
If I > 2 And I 19 And I 36 And I < 48 Then



Range('c3:c5').Select
Selection.Copy
Windows('TRAVAIL TARIF').Activate
Cells(5, I).Activate
ActiveSheet.Paste
Cells(5, I).Validation.Delete
Cells(6, I).Validation.Delete
Cells(7, I).Validation.Delete
Windows(2).Activate
Application.CutCopyMode = False


Range('c44:c45').Select
Selection.Copy
Windows('TRAVAIL TARIF').Activate
Cells(49, I).Activate
ActiveSheet.Paste
Cells(49, I).Validation.Delete
Cells(50, I).Validation.Delete
Windows(2).Activate
Application.CutCopyMode = False

Range('c73').Select
Selection.Copy
Windows('TRAVAIL TARIF').Activate
Cells(79, I).Activate
ActiveSheet.Paste
Cells(79, I).Validation.Delete
Windows(2).Activate
Application.CutCopyMode = False

Range('c102:c103').Select
Selection.Copy
Windows('TRAVAIL TARIF').Activate
Cells(110, I).Activate
ActiveSheet.Paste
Cells(110, I).Validation.Delete
Cells(111, I).Validation.Delete
Windows(2).Activate
Application.CutCopyMode = False

Range('c131:c132').Select
Selection.Copy
Windows('TRAVAIL TARIF').Activate
Cells(141, I).Activate
ActiveSheet.Paste
Cells(141, I).Validation.Delete
Cells(142, I).Validation.Delete
Windows(2).Activate
Application.CutCopyMode = False

Range('c151').Select
Selection.Copy
Windows('TRAVAIL TARIF').Activate
Cells(162, I).Activate
ActiveSheet.Paste
Cells(162, I).Validation.Delete
Windows(2).Activate
Application.CutCopyMode = False

Range('d7:d41').Select
Selection.Copy
Windows('TRAVAIL TARIF').Activate
Cells(11, I).Select
ActiveSheet.Paste
Windows(2).Activate
Application.CutCopyMode = False

Range('d47:d69').Select
Selection.Copy
Application.Windows('TRAVAIL TARIF').Activate
Cells(53, I).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Windows(2).Activate
Range('d75:d98').Select
Selection.Copy
Windows('TRAVAIL TARIF').Activate
Cells(82, I).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Windows(2).Activate
Range('d105:d128').Select
Selection.Copy
Windows('TRAVAIL TARIF').Activate
Cells(114, I).Select
ActiveSheet.Paste
Application.CutCopyMode = False


Windows(2).Activate
Range('d134:d147').Select
Selection.Copy
Windows('TRAVAIL TARIF').Activate
Cells(145, I).Select
ActiveSheet.Paste
Application.CutCopyMode = False


Windows(2).Activate
Range('d153:d155').Select
Selection.Copy
Windows('TRAVAIL TARIF').Activate
Cells(165, I).Select
ActiveSheet.Paste
Application.CutCopyMode = False




Application.Windows(2).Activate
ActiveWorkbook.Close SaveChanges:=False


'for = T


End If

Exit Sub
ligne600:
If T < 48 Then T = T + 1 Else Sheets('tarifaire').Protect: End
Resume



Application.ScreenUpdating = True
Application.Goto Range('A10')

End If

End Sub