raccourcir code

[jacky49]

Bonsoir à tous,

je voudrais raccourci ce code , j'ai essayé en enlevant quelques lignes , la 1ère fois il a fonctionné et ensuite non pourquoi , je ne sais pas
le 1er code, c'est celui que je veux raccourcir

Sub essaicopiercolonnes()

    Range("B5:B103").Select
    ActiveWindow.SmallScroll Down:=-105
    Range("B5:B103,D5:F103").Select
    Range("D5").Activate
    ActiveWindow.SmallScroll Down:=-117
    Range("B5:B103,D5:F103,M5:M103").Select
    Range("M5").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Classement 3 Routes Masculin 2016.xlsm").Activate
    Range("B7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("L7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll ToRight:=14
    Range("V7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AJ7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll ToRight:=14
    Range("AT7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll ToRight:=7
    Range("BC7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll ToRight:=9
    Range("BQ7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll ToRight:=10
    Range("CA7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("CK7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll ToRight:=16
    Range("CY7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll ToRight:=9
    Range("DQ7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll ToRight:=10
    Range("EO7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.ScrollColumn = 139
    ActiveWindow.ScrollColumn = 122
    ActiveWindow.ScrollColumn = 1
    Range("B7").Select
    'Windows("Inscrits.xls").Activate
    'ActiveWindow.SmallScroll Down:=-126
    'Range("B1").Select
End Sub

le 2ème , c'est celui que j'ai raccourci et qui a fonctionné une seule fois

Sub essaicopiercolonnes2()
    Range("B5:B103,D5:F103,M5:M103").Select
    Range("M5").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Classement 3 Routes Masculin 2016.xlsm").Activate
    Range("B7").Select
    Range("L7").Select
    Range("V7").Select
    Range("AJ7").Select
    Range("AT7").Select
    Range("BC7").Select
    Range("BQ7").Select
    Range("CA7").Select
    Range("CK7").Select
    Range("CY7").Select
    Range("DQ7").Select
    Range("EO7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

merci d'avance

 

[Hieu]

Re : raccourcir code

Salut,

Lorsque tu fais ta manip, il faut que le fichier "Classement 3 Routes Masculin 2016.xlsm" soit ouvert. Sinon, je n'ai pas compris, pourquoi tu selectionnes les cellules les unes, après les autres ? Pas d'intéret.

Voici un essai :

Sub essaicopiercolonnes2()
    Range("B5:B103,D5:F103,M5:M103").Copy
Windows("Classement 3 Routes Masculin 2016.xlsm").Activate
    Sheets("Feuil2").Range("EO7").PasteSpecial _
     Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Application.CutCopyMode = False
End Sub

J'ai ajouté le nom de la feuille sur laquelle tu voudrais écrire; ça pourrait être pas mal si ton fichier a plusieurs onglets

++

 

[jacky49]

Re : raccourcir code

Bonsoir le forum,Hieu,

en fait sur le même onglets, j'ai plusieurs tableau identiques et donc je copie les colonnes sur chaque tableau qui commence aux colonnes indiqués (B7, L7 etc...) , merci de ton aide
jacky

 

[Hieu]

Re : raccourcir code

Re Jacky,

Disons qu'un petit fichier excel, des fois, ça aide la compréhension ?!

 

[jacky49]

Re : raccourcir code

re Hieu,

oui je comprends mais mon fichier est tres gros donc pas évident, j'ai donc refait 2 classeurs qui sont identiques à ce que j'ai
merci d'avance

 

[thebenoit59]

Re : raccourcir code

Bonjour Jacky, bonjour Hieu.

En passant avec un tableau, pour faire différemment. Au moins ça évite les copier-coller.
A toi de voir comment tu souhaites définir le classeur Compil. Tu peux appeler son ouverture s'il n'est pas ouvert. Mais dans le code ci-dessous, nous considérons qu'il l'est.

Option Explicit

Sub Transfère_Données()
'Déclaration des variables
Dim a, Données, c
Dim WkSource As Workbook, WkCompil As Workbook
Dim ShSource As Worksheet, ShCompil As Worksheet
Dim i As Integer
Dim d As Object

'Enregistrement des objets
Set WkSource = ThisWorkbook
Set ShSource = WkSource.Sheets("Feuil1")
Set WkCompil = Workbooks("Classement 3 Routes Masculin 2016.xlsm")
Set ShCompil = WkCompil.Sheets("Feuil1")
Set d = CreateObject("Scripting.Dictionary")

'Mise sour forme de tableau des zones à copier
a = ShSource.[b5:m103]
For i = LBound(a) To UBound(a)
    d(i) = Array(a(i, 1), a(i, 3), a(i, 4), a(i, 5), a(i, 12))
Next i
Données = Application.Transpose(Application.Transpose(d.items))

'On enregistre les colonnes où sera collé le tableau
c = Array("B", "L", "V", "AJ", "AT", "BC", "BQ", "CA", "CK", "CY", "DQ", "EO")
'On boucle
For i = 0 To 11
    ShCompil.Range(c(i) & 7).Resize(UBound(Données), UBound(Données, 2)) = Données
Next
End Sub

A part l'écart de colonnes, n'étant pas les mêmes que dans le code du début, cela fonctionne

 

[jacky49]

Re : raccourcir code

Bonsoir Hieu,thebenoit59,

j'ai une erreur avec ton code, il me met "erreur d'exécution 1004" la méthode intersect de l'objet application a echoué
et il me surligne cette ligne :
ShCompil.Range(c(i) & 7).Resize(UBound(Données), UBound(Données, 2)) = Données

merci

 

[thebenoit59]

Re : raccourcir code

Bonjour Jacky.

Ne sachant te dire d'où peut provenir cette erreur, je te transmets le code adapté aux deux fichiers que tu as transmis.
J'en ai profité pour le commenter.

 

[jacky49]

Re : raccourcir code

Bonsoir le forum, Thebenoit59,

le code fonctionne impec sur les fichiers exemple mais quand je le mets dans mon fichier original, si le classeur est ouvert, il me met un message d'avertissement disant que le fichier est déja ouvert(ce qui est normal)donc je mets non et il me copie rien.
Si le fichier n'est pas ouvert, il l'ouvre et me met une erreur et me surligne cette ligne:

Set WkCompil = Workbooks.Open(ThisWorkbook.Path & "\Classement 3 Routes Masculin 2016.xls")

Car dans mon classeur classement, j'ai des macros donc le format est différent mais je l'ai mis en 97-2003 donc en .xls., ce qui doit être bon
Sinon 2 questions, sur le 1er code que tu avais fait, je pouvais choisir la feuille source et la feuille de destination car sur mon classeur inscrits, j'ai plusieurs onglets avec des catégories différentes et de mêm sur le classeur de destination
merci de ton aide
jacky

Re: je pense que c'est un problème de nom de fichier ou de format de fichier xlsm car c'est toujours la même ligne qu'il me surligne et du coup le code ne fonctionne pas
merci

 

[thebenoit59]

Re : raccourcir code

Bonsoir Jacky.

Tu peux toujours choisir les onglets, dans le dernier fichier, j'ai mis Sheets (1) ce qui correspond au numéro d'onglet. Tu peux le remplacer par Sheets ("Nom de la feuille").

Pour le reste, je ne vois pas ce qui plante.
Peux tu m'envoyer le fichier sur lequel ça ne fonctionne pas ?

 

[jacky49]

Re : raccourcir code

Bonsoir le forum, thebenoit59,

je peux mais il est trop gros pour le mettre sur le forum et il y a des données perso donc je ne sais pas trop comment faire
peut être en PV
merci de ton aide

 

[jacky49]

Re : raccourcir code

Bonjour le forum, thebenoit59,

J'ai réussi à faire fonctionner le code sur mes fichiers, j'ai tout fermé, tout rouvert et j'ai copier le code dans mon fichier original et la génial ça fonctionne, j'avais pourtant fait pareil hier(j'avais quand même du faire une erreur)
thebenoit59, peux tu faire une modif dans le code, car la je suis obligé de fermer le classeur classement à chaque fois, je voudrais pouvoir le garder ouvert et donc que le code se recopie le classeur ouvert
merci d'avance
jacky