compiler 2 onglets

1 pièce(s) jointe(s)

compiler 2 onglets

Help !
J’ai un fichier Excel avec 2 onglets et je veux compiler ces 2 onglets sur un nouveau onglet via une macro, et je veux copier et coller que les plages qui sont renseignés, qui ne comportent pas de #N/A. Ci-joint un ex.

merci de votre aide

Salut,
Voici un petit code rapide, je pense avoir mis assez de commentaire pour qu'il soit compréhensible. Tu aurras certainement d'autres propositions...

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
Sub CopieVersC()
'
Dim DerLigneA As Long, DerLigneB As Long, DerLigneC As Long, i As Long
 
DerLigneA = Sheets("A").Cells(Columns(1).Rows.Count, 1).End(xlUp).Row 'Defini la dernière ligne
DerLigneB = Sheets("B").Cells(Columns(1).Rows.Count, 1).End(xlUp).Row 'Defini la dernière ligne
DerLigneC = 2 'Défini la valeur pour le collage
 
Sheets("A").Range("A1:D1").Copy Destination:=Sheets("C").Range("a1") 'Copie la ligne des titres
 
Sheets("A").Activate 'Active la feuille A, nécessaire pour le copié
For i = 2 To DerLigneA 'Fait une boucle de 2 à la dernière ligne; 2 car titre
    If Sheets("A").Cells(i, 1).Value <> 0 Then 'vérifie si la valeur = 0 sur base de la colonne A
    Sheets("A").Range(Cells(i, 1), Cells(i, 4)).Copy Destination:=Sheets("C").Cells(DerLigneC, 1) 'si non copie vers feuilleC
    DerLigneC = DerLigneC + 1 'Incrémente la ligne de destination de la feuilleC
    End If
Next i
 
'Idem pour la feuilleB
Sheets("B").Activate
For i = 2 To DerLigneB
    If Sheets("B").Cells(i, 1) <> 0 Then
    Sheets("B").Range(Cells(i, 1), Cells(i, 4)).Copy Destination:=Sheets("C").Cells(DerLigneC, 1)
    DerLigneC = DerLigneC + 1
    End If
Next i
 
End Sub

A+

Merci bcoup ! ca foctionne!:ccool: