Résolu Concatenation onglets en un seu - Excel VBA

[geoffroy.villejoubert]

Bonjour,

Je suis à la recherche d'un code VBA pour "concatener" plusieurs onglets en 1.

Je m'explique, j'ai un fichier excel avec X onglets.
Dans chaque onglet, j'ai 107 colonnes (de A à DC) et 2127 lignes.
Mes colonnes A à G sont identiques dans chaque onglet (le contenue des cellules aussi). Seul le contenu des colonnes H à DC varie.
Je cherche donc à avoir un seul onglet avec le contenu des colonnes A à G puis le contenu pour chaque onglet des colonnes H à DC à la suite des autres.

Je n'ai pas trouvé comment fournir un fichier, je donne donc une version visuelle de ce que je souhaiterai :

Onglet 1 :

P	Q	A	B
1	11		
2	12	1	
3	13	1	
4	14	2	2
5	15		2

Onglet 2

P	Q	D	E
1	11		
2	12		1
3	13		
4	14	1	
5	15		1

Onglet concaténation

P	Q	A	B	D	E
1	11				
2	12	1			1
3	13	1			
4	14	2	2	1	
5	15		2		1

La seule chose que j'arrive à faire c'est de les copier coller mais les uns sous les autres et ce n'est pas ce que je souhaite...

--> Ce que j'obtiens mais que je ne veux pas :

P	Q	A	B
1	11		
2	12	1	
3	13	1	
4	14	2	2
5	15		2
P	Q	D	E
1	11		
2	12		1
3	13		
4	14	1	
5	15		1

avec le code suivant

Sub test2()
Dim ws As Worksheet

For Each ws In Worksheets
If ws.Name <> "recap" Then
ws.Range(ws.Range("A1"), _
ws.Range("A1").SpecialCells(xlCellTypeLastCell)).Copy _
Destination:=Worksheets("recap").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next
End Sub

Je pense avoir les bases avec ce code, mais je ne maitrise pas encore la chose ce qui fait que je bloque et n'arrive pas à le transposer comme je voudrai.

Merci d'avance pour votre aide
Geoffroy

 

[geoffroy.villejoubert]

Solution trouvée avec l'aide d'autres personnes

Merci

Sub Bouton8_Cliquer()
    With Sheets("recap")
        .Cells.ClearContents
        For Each ws In Sheets
            If ws.Name <> .Name Then
                lc = ws.Cells(1, Columns.Count).End(xlToLeft).Column
                ll = ws.Cells(Rows.Count, 1).End(xlUp).Row
                If .Cells(1, 1) = "" Then fc = 1: nc = 1 Else fc = 2
                Range(ws.Cells(1, fc), ws.Cells(11, lc)).Copy .Cells(1, nc)
                nc = nc + lc
            End If
        Next
    End With
End Sub

 

[job31]

Merci à toi de l'avoir donné