Selection colonne entière grâce au header et copie des lignes non vides

Bonjour,

J'ai réussi à sélectionner une colonne entière grâce au nom de son header en VBA, mais maintenant je souhaiterais copier toute cette colonne dans une autre feuille.

Or le problème est que quand je sélectionne la colonne, Excel la copie de la première ligne, à la toute dernière (donc la ligne 16 384)... Cela rend donc mon fichier très lourd et l'exécution de la macro très longue.

Je souhaiterais donc avoir une formule qui me permet de sélectionner uniquement les colonnes remplies.

Voici mon un extrait de mon code qui permet de sélectionner une colonne grâce au nom du header :

Dim coll As Object
Set coll = CreateObject("System.Collections.ArrayList")
coll.Add "N_INCIDENT"
coll.Add "DATE_CREATION"

Dim i As Long
For i = 0 To coll.Count - 1
    Worksheets("TT Brut").Select
    Dim a As Integer: a = WorksheetFunction.Match(coll(i), Sheets("TT Brut").Rows(1), 0)
    Columns(a).Copy Destination:=Sheets("TTT").Columns(i + 1)
Next i

Avant j'utilisais le code suivant, mais j'étais obligé d'indiquer le numéro de la colonne (ou plutôt la lettre) :

Range("F2:F" & Range("F" & Rows.Count).End(xlUp).Row)

Merci d'avance pour votre aide.

Alexandre

Bon, j'ai réussi à résoudre mon problème tout seul :

J'ai converti le numéro de colonne en lettre de colonne, puis j'ai appliqué ma formule précédente qui prend uniquement les cellules remplies.

Dim coll As Object
Set coll = CreateObject("System.Collections.ArrayList")
coll.Add "N_INCIDENT"
coll.Add "DATE_CREATION"

Dim i As Long
For i = 0 To coll.Count - 1
    Worksheets("TT Brut").Select
    Dim a As Integer: a = WorksheetFunction.Match(coll(i), Sheets("TT Brut").Rows(1), 0)
    Dim ColLetter As String: ColLetter = Split(Cells(1, a).Address, "$")(1)

    Range(ColLetter & "1:" & ColLetter & Range(ColLetter & Rows.Count).End(xlUp).Row).Select

    Selection.Copy Destination:=Sheets("TTT").Columns(i + 1)
    'Worksheets("TTT").Columns(i + 1).Cells(1).Value = coll2(i)
Next i

Bonjour,

Un exemple à adapter.

Cdlt.

Sub TEST()
Dim coll As Object
Dim I As Long, a As Long
    Set coll = CreateObject("System.Collections.ArrayList")
    coll.Add "N_INCIDENT"
    coll.Add "DATE_CREATION"
    For I = 0 To coll.Count - 1
        With Worksheets("TT Brut")
            a = WorksheetFunction.Match(coll(I), .Rows(1), 0)
            .Columns(a).Copy Destination:=Worksheets("TTT").Columns(I + 1).Cells(1)
        End With
    Next I
End Sub

Jean-Eric a écrit :

Bonjour,

Un exemple à adapter.

Cdlt.

Sub TEST()
Dim coll As Object
Dim I As Long, a As Long
    Set coll = CreateObject("System.Collections.ArrayList")
    coll.Add "N_INCIDENT"
    coll.Add "DATE_CREATION"
    For I = 0 To coll.Count - 1
        With Worksheets("TT Brut")
            a = WorksheetFunction.Match(coll(I), .Rows(1), 0)
            .Columns(a).Copy Destination:=Worksheets("TTT").Columns(I + 1).Cells(1)
        End With
    Next I
End Sub

Merci pour votre réponse, mais là vous faites au final la même chose que ma première solution, à savoir copier la colonne entière, cellules vides comprises.

Re,

Sub TEST()
Dim coll As Object
Dim I As Long, lCol As Long, lastRow As Long
    Set coll = CreateObject("System.Collections.ArrayList")
    coll.Add "N_INCIDENT"
    coll.Add "DATE_CREATION"
    For I = 0 To coll.Count - 1
        With Worksheets("TT Brut")
            lCol = WorksheetFunction.Match(coll(I), .Rows(1), 0)
            lastRow = .Cells(.Rows.Count, lCol).End(xlUp).Row
            .Cells(lCol).Resize(lastRow).Copy Destination:=Worksheets("TTT").Columns(I + 1).Cells(1)
        End With
    Next I
End Sub

Bonjour à tous

A tout hasard j'avais utilisé cette solution avec un filtre pour extraire puis copier les données non vides d'une colonne

A adapter si intérêt

ActiveSheet.Range(Cells(1, 1), Cells(Vlf, Vcf)).AutoFilter Field:=4, Criteria1:="<>", Operator:=xlAnd

Sheets("Base").Range("_FilterDataBase").Columns("d:d").SpecialCells(xlCellTypeVisible).COPY

Cordialement

FINDRH