Discussion :

[trouvaille]

Bonjour,

J'ai un classeur que je vais appeler pour la compréhension DESTINATION comportant des lignes vides.
je voudrais insérer des données venant d'un autre classeur précisément à partie de la ligne 6 dans le classeur DESTINATION
Dans DESTINATION, Les lignes de la colonne B sont fusionnées par deux (6 et 7, 8 et 9 et ainsi de suite)
Dans un classeur que je vais appeler PREMIER en colonne A des données numériques classées en ordre croissant et colonne B des données numériques (18 chiffres)
Dans un classeur que je vais nommer DEUXIEME en colonne A les même données numériques classées en ordre croissant et en colonne B des données numériques 30 chiffres)
Je ne peux modifier la mise en page du classeur de destination que j'aimerai remplir automatiquement.
il faudrait:
Prendre la valeur de A dans PREMIER et le mettre dans B dans DESTINATION pour commencer la boucle en ligne 6 et 7 (fusionnée)
Prendre la valeur de B dans PREMIER et le mettre dans D dans DESTINATION en ligne 6
Prendre la valeur de B (valeur de A correspondant à valeur inscrite en B DESTINATION) dans DEUXIEME et le mettre dans D dans DESTINATION en ligne 7

en boucle sur toutes les lignes (égales dans le classeur PREMIER et DEUXIEME)

Merci de votre solution, car je dois faire très régulièrement ce copier coller à la main

[Franc]

Salut, j'écris cette macro en supposant que tous les classeurs sont ouverts et les données se trouvent sur la première feuille. A toi d'adapter si besoin.

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
Sub CopierDonnees()
    Dim wbDestination As Workbook
    Dim wbPremier As Workbook
    Dim wbDeuxieme As Workbook
    Dim wsDestination As Worksheet
    Dim wsPremier As Worksheet
    Dim wsDeuxieme As Worksheet
    Dim i As Long
    Dim j As Long
 
    'Définir les classeurs et les feuilles de calcul
    Set wbDestination = Workbooks("DESTINATION.xlsx")
    Set wbPremier = Workbooks("PREMIER.xlsx")
    Set wbDeuxieme = Workbooks("DEUXIEME.xlsx")
    Set wsDestination = wbDestination.Sheets(1)
    Set wsPremier = wbPremier.Sheets(1)
    Set wsDeuxieme = wbDeuxieme.Sheets(1)
 
    'Boucle pour copier les données
    j = 6 'Ligne de départ dans DESTINATION
    For i = 1 To wsPremier.Cells(Rows.Count, 1).End(xlUp).Row 'Boucle sur toutes les lignes de PREMIER
        wsDestination.Cells(j, 2).Value = wsPremier.Cells(i, 1).Value 'Copier la valeur de A dans PREMIER dans B dans DESTINATION
        wsDestination.Cells(j, 4).Value = wsPremier.Cells(i, 2).Value 'Copier la valeur de B dans PREMIER dans D dans DESTINATION
        wsDestination.Cells(j + 1, 4).Value = wsDeuxieme.Cells(i, 2).Value 'Copier la valeur de B dans DEUXIEME dans D dans DESTINATION
        j = j + 2 'Passer à la prochaine paire de lignes fusionnées dans DESTINATION
    Next i
End Sub