Code VBA - Copier / Coller des listes à la suite

Version imprimable

Bonjour,

Je bloque sur une partie de mon code.
J'ai réussi à faire un code pour récupérer un fichier Excel et copier /coller les colonnes C, D et M à partir de la ligne 15.

Mais je voudrais maintenant coller à la suite de cela, les colonnes E, F et N.

Je vous met mon code ci-dessous.

Code:

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
Sub Choix_du_Fichier()
 
Dim FichierSource As Variant
 
Dim Source As Workbook
Dim Cible As Worksheet
 
    On Error GoTo Fin
 
    Set Cible = Sheets("Fin de Travaux réalisés")
    FichierSource = Application.GetOpenFilename("Fichiers (*.xlsx),*.xlsx")
 
    If FichierSource = False Then GoTo Fin
 
    Application.ScreenUpdating = False
    Set Source = Workbooks.Open(FichierSource)
    With Source
         .Sheets("Fin de Travaux réalisés").Range("C15:D800,M15:M800").Copy Destination:=Cible.Range("A1")
         .Close False
    End With
    Application.ScreenUpdating = True
 
    MsgBox "Fin de l'import !"
    GoTo Fin
 
Fin:
 
    Application.ScreenUpdating = True
 
    Set Cible = Nothing
    Set Source = Nothing
 
End Sub

Si quelqu'un à une idée, merci à vous.

Aide

Bonjour
il faut rajouter au niveau de ta ligne 18/19

Code:

1
2
3
4
5
6
 
With Source
         .Sheets("Fin de Travaux réalisés").Range("C15:D800,M15:M800").Copy Destination:=Cible.Range("A1")
         .Sheets("Fin de Travaux réalisés").Range("E15:F800,N15:N800").Copy Destination:=Cible.Range("D1")
         .Close False
End With

23/05/2022, 16h33
Mia30

Fab_de_chez_PERFORM, merci pour ta proposition mais les deux colonnes ce mettent côte à côte. Serais-tu comment faire pour que la deuxième ce mettent en dessous de la premier ?

Merci à toi
23/05/2022, 18h32
Raccourcix

Bonjour

Pour moi, avec la version 365, il FAUT faire ce genre de manip avec Power Query et non en VBA. (module intégré pleinement à Excel depuis la version 2016)
Vous importez facilement votre fichier (menu Données/Obtenir des données/importer un fichier/fichier Excel)
Vous sélectionnez vos données et choisissez la colonne qui vous intéresse
Vous dupliquez cette requête et modifiez le nom de la colonne.

Enfin vous "ajoutez" vos requêtes l'une sous l'autre et vous chargez le tout dans votre classeur.

Quelques clics, pas de code à taper, très facile à modifier au besoin.
Vous pourrez paramétrer facilement votre source de données si elle vient à changer.

Stéphane

Aide

Bonjour
je rejoins Stéphane pour l'utilisation de Query mais comme il y a marqué qu'il s'agit d'un point bloquant sur un bout de code voici 2 réponses
La 1ère si le nb de lignes en A, B et C est différent

Code:

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
46
47
48
49
50
51
52
53
54
Sub Choix_du_Fichier() 'avec nb lignes différentes A B M
 
Dim FichierSource As Variant
 
Dim Source As Workbook
Dim Cible As Worksheet
 
    On Error GoTo Fin
 
    Set Cible = Sheets("Fin de Travaux réalisés")
    FichierSource = Application.GetOpenFilename("Fichiers (*.xlsx),*.xlsx")
 
    If FichierSource = False Then GoTo Fin
 
    Application.ScreenUpdating = False
    Set Source = Workbooks.Open(FichierSource)
    With Source
         .Sheets("Fin de Travaux réalisés").Range("C15:D800,M15:M800").Copy Destination:=Cible.Range("A1")
    End With
 
    Dim Ligne_A As Integer
    Ligne_A = Range("A" & Rows.Count).End(xlUp).Row + 1
 
    With Source
         .Sheets("Fin de Travaux réalisés").Range("E15:E800").Copy Destination:=Cible.Range("A" & Ligne_A)
    End With
 
    Dim Ligne_B As Integer
    Ligne_B = Range("B" & Rows.Count).End(xlUp).Row + 1
 
    With Source
         .Sheets("Fin de Travaux réalisés").Range("F15:F800").Copy Destination:=Cible.Range("B" & Ligne_B)
    End With
 
    Dim Ligne_C As Integer
    Ligne_C = Range("C" & Rows.Count).End(xlUp).Row + 1
    With Source
         .Sheets("Fin de Travaux réalisés").Range("n15:n800").Copy Destination:=Cible.Range("C" & Ligne_C)
         .Close False
    End With
 
    Application.ScreenUpdating = True
 
    MsgBox "Fin de l'import !"
    GoTo Fin
 
Fin:
 
    Application.ScreenUpdating = True
 
    Set Cible = Nothing
    Set Source = Nothing
 
End Sub

La deuxième si le nb de lignes est identique :

Code:

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
Sub Choix_du_Fichier_bis() 'avec nb lignes identiques A B M
 
Dim FichierSource As Variant
 
Dim Source As Workbook
Dim Cible As Worksheet
 
    On Error GoTo Fin
 
    Set Cible = Sheets("Fin de Travaux réalisés")
    FichierSource = Application.GetOpenFilename("Fichiers (*.xlsx),*.xlsx")
 
    If FichierSource = False Then GoTo Fin
 
    Application.ScreenUpdating = False
    Set Source = Workbooks.Open(FichierSource)
    With Source
         .Sheets("Fin de Travaux réalisés").Range("C15:D800,M15:M800").Copy Destination:=Cible.Range("A1")
    End With
 
    Dim Ligne_A As Integer
    Ligne_A = Range("A" & Rows.Count).End(xlUp).Row + 1
 
    With Source
         .Sheets("Fin de Travaux réalisés").Range("E15:f800, n15:n800").Copy Destination:=Cible.Range("A" & Ligne_A)
         .Close False
    End With
 
    Application.ScreenUpdating = True
 
    MsgBox "Fin de l'import !"
    GoTo Fin
 
Fin:
 
    Application.ScreenUpdating = True
 
    Set Cible = Nothing
    Set Source = Nothing
 
End Sub

24/05/2022, 13h57
Mia30

Bonjour Fab_de_chez_PERFORM,
Merci beaucoup pour ton code il fonctionne nickel.
J'aurais une dernière petite question.
Si ma ligne ne commence pas à la 15, comment pourrais-je faire ?

Par exemple les lignes que je veut copier commence à la 12 ou à la 19, cela dépend du fichier.
il y a d'autre ligne "non concerné au dessus" et je veut commencer à copier mes lignes dès que la valeur de la case est "C" comment pourrais-je faire ?

Merci à vous pour votre temps

Aide

Bonjour Mia
je te conseille d'aller nommer ta première cellule sur tes classeurs (ex : nommer A15 "première_cellule")

du coup il te faut insérer dans le code la récupération du numéro de ligne de cette cellule nommée et la reporter dans ta sélection
exemple :
Code:

1 2 3 4 5 6 Dim ma_ligne ma_ligne = Range("première_cellule").Row With Source .Sheets("Fin de Travaux réalisés").Range("C" & ma_ligne & ":D800,M" & ma_ligne & ":M800").Copy Destination:=Cible.Range("A1") End With
sinon, comme le classeur s'ouvre et se voit, tu pourrais faire apparaitre une input box afin d'y saisir le numéro de ta ligne

@+

30/05/2022, 09h13
Mia30

Bonjour,
Ca fonctionne nickel merci à toi pour ton aide :)