T
tony
Guest
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
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