Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

probleme de copier coller

  • Initiateur de la discussion Initiateur de la discussion tony
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
11
Affichages
848
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…