Discussion :

[CEA FRANCE]

Bonjour.
Ci-dessous le code que j'ai écris pour faire une copie de plusieurs ligne selectionné dans une listbox pour la copier dans un autre classeur.
Question peut-on le faire en une seule fois en faisant un genre de Range ("7:7,11:11,16:16").Select mais là il faut remplir une variable et je ne vois pas trop comment...
si quelqu'un a la solution...
MERCI

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Private Sub CommandButton3_Click()
 Workbooks.Open Filename:="D:\Bureautique\Mes Documents\Base.xlsx"
 With ListBox1
 Windows("BASE.xlsx").Activate
 ActiveWindow.LargeScroll ToRight:=-1
 Range("A1").Select
 Selection.CurrentRegion.Select
 nbre_de_ligne = Selection.Rows.Count
 Workbooks("COLLAGE.xlsm").Activate
 Sheets("DONNEES").Select
 For i = 0 To .ListCount - 1
 ' If .Selected(i) = True Then
 ' mess = mess & i + 2 & ":" & mess & i + 2
 ' If mess <> "" Then
 ' mess = mess & ","
 ' End If
 If .Selected(i) = True Then
 nbre_de_ligne = nbre_de_ligne + 1
 Windows("COLLAGE.xlsm").Activate
 Sheets("DONNEES").Select
 Cells(i + 2, 1).Select
 Range(Selection, Selection.End(xlToRight)).Select
 Selection.Copy
 
 Windows("BASE.xlsx").Activate
 Cells(nbre_de_ligne, 1).Select
 ActiveSheet.Paste
 
 End If
 Next
 ' Sheets ("PRINCIPAL")
 End With
 Windows("BASE.xlsx").Activate
 Application.DisplayAlerts = False ' supprime les messages d'alerte
 ActiveWorkbook.Save ' sauve le classeur meme s il existe sans demande confirmation
 Application.DisplayAlerts = True ' repositionne les messages d'alertes...
 ActiveWindow.Close
 Windows("COLLAGE.xlsm").Activate
 ' MsgBox mess
 ' Range("7:7,11:11,16:16").Select
 ' Range("A16").Activate
 ' Selection.Delete Shift:=xlUp
 
 
 End Sub

[patricktoulon]

moi j'ai une qustion pour toi cea

puisque tu a tes lignes dans ta listbox pourquoi repasser mar le shhet source plutôt que retranscrire les lignes de ta listbox dans la destination hein!!!???? t'y a pensé!!!!

[CEA FRANCE]

pour tout te dire et tu dois t'en douter je ne maitrise pas du tout les listbox et tout le toutim...
je suis de la génération EXCEL 5.0 en Français... et tout ça n'existait pas
mais j'apprends et c'est pas mon cœur de métier... j'apprends..
si tu as une solution plus simple je suis a l'écoute
MERCI

[patricktoulon]

je viens de regarder c'est ce foutoir divise le nombre de lignes de code par 3 et bien il t'en faut moins que ca pour faire ce que tu veux

si tu suis mon idée organise une variable tableau sur les item selectionnés de ta list box

si tu continue a vouloir ativate ,select reactivate reselect et même deux fois on se demande pour quoi d'ailleurs

fait une recherche du cote de union
et copydestination:=

on va quand même pas tout faire a ta place a chaque fois sinon tu nous donne ton salaire hein !!!!
la j'ai vraiment tout dis

[cerede2000]

@Patrick : Tu m'as tué !! Je suis mort de rire mon moment délire du vendredi soir

[patricktoulon]

pour tout te dire et tu dois t'en douter je ne maitrise pas du tout les listbox et tout le toutim...
je suis de la génération EXCEL 5.0 en Français... et tout ça n'existait pas

même si tu ne connais pas, vu la galère que c'était excel 5.0 ca devrait être facile pour toi le vba6

[CEA FRANCE]

J'ai beau réfléchir... je ne vois pas...
Y'a beaucoup plus de commande... et avec des commandes qui optimiser en nombres d'exécutions... c'est ce que je cherche a faire aussi.

[patricktoulon]

oui je sais le vendredi soir moi aussi je suis un brute de décoffrage la fatigue sans doute
t'é pas mort hein!!!? dis moi cerede2000 vit encore un peu j'ai une surprise pour toi avec les classe sans classe après tu pourra être tout mourru si tu veux

laisse rouler ma créativité

[patricktoulon]

re
bon réfléchir c'est bien !!
mais quand on pas les bases on va les chercher FAQ,CONTRIBUTIONS ,et même le FORUM
ca servirait a rien que je t'explique comment remplir un tableau a 2 dimensions si tu ne sais même pas ce que c'est

fait une recherche sur les variables tableaux aussi et prévois le nurofen

[CEA FRANCE]

oups pardon...
j'avais pas vu que vous aviez écris plus haut...
alors de réfléchi a nouveau... a plus tard

[patricktoulon]

on va commencer par tes méprise du contexte

meprise1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 Workbooks.Open Filename:="D:\Bureautique\Mes Documents\Base.xlsx"
 With ListBox1
 Windows("BASE.xlsx").Activate  'ici!!!!!!!! pourquoi tu activate ?????? puisque tu viens de l'ouvrir il est donc actif

meprise 2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 Workbooks("COLLAGE.xlsm").Activate  'bon allez si tu veux 
 Sheets("DONNEES").Select
 For i = 0 To .ListCount - 1
 ' If .Selected(i) = True Then
 ' mess = mess & i + 2 & ":" & mess & i + 2
 ' If mess <> "" Then
 ' mess = mess & ","
 ' End If
 If .Selected(i) = True Then
 nbre_de_ligne = nbre_de_ligne + 1
 Windows("COLLAGE.xlsm").Activate  'ici heu pourquoi il l'est déjà ?????????????
 Sheets("DONNEES").Select

alors je te donne un indice

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
set wbk1=thisworkbook
set wbk2=workbooks.open blablablabla
 
thisworkbook.sheets(X).range(xy:x²y²).copy destination:=wbk2.sheets(z).cells(rows.count,1).end(xlup)

voila ces 3 lignes copy un plage du classeur1 vers la première ligne dispos du classeur 2

[CEA FRANCE]

Je n'y arrive pas... ça ne fonctionne pas

Je crois que malheureusement je vais garder ma première formule. Je n'y arrive pas autrement.
Je suis toujours prenneur d'une formule plus simple.
MERCI

[patricktoulon]

re
c'est quoi qui fonctionne pas montre nous ce que tu à tenté

[CEA FRANCE]

Avec un peu de délais ma technique est donc la suivante : je pointe avec une croix les lignes à transférer lorsque je VALIDE le transfert.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub CommandButton3_Click()
 With ListBox1
    Sheets("DONNEES").Select
    For i = 0 To .ListCount - 1
        If .Selected(i) = True Then
            Cells(i + 2, "Q") = "X"
          End If
    Next
 End With

et ensuite, je reprends ma feuille, je filtre ma croix et je copie et colle dans un autre classeur...