Discussion :

[bzh.floriane]

Bonjour, j'ai une fonction CleanTable(TableFind As Range) qui prend en argument un tableau avec des colonnes vides et non-vides

J'essaye que ma fonction, supprime les colonnes vides, sachant que sur certaines colonnes seulement une cellule est non-vide

Voici mon code :

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
Function CleanTable(TableFind As Range)
    Dim Sh As Worksheet
    Dim Ln As Integer, Col As Integer, MaxCol As Integer
 
    Chemin = ThisWorkbook.path
    Set Sh = ThisWorkbook.Sheets("Sheet1")
    Workbooks.Open (Chemin & "/Classeur_travail.xlsx")
 
        For Col = 256 To 1 Step -1
            If TableFind.Application.CountA(Columns(Col)) = 0 Then
            TableFind.Cells(1, Col).EntireColumn.Delete Shift:=xlToLeft
        Next Col
 
    TableFind.Copy Sh.Cells(20, 1)
End Function

Mais cela ne supprime aucune colonne. Merci de votre aide

[Invité]

Bonjour,


A première vue, il manque un End If.

Sinon, pourquoi utiliser une fonction si elle ne renvoie rien ?

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
28
29
30
31
32
33
34
35
36
 
 
Sub TestEffacerLesColonnes()
 
    EffacerLesColonnes Sheets("Feuil1"), "D:\XXXX\Classeur_travail.xlsx"  'A adapter
 
End Sub
 
 
Sub EffacerLesColonnes(ByVal ShCible As Worksheet, ByVal CheminComplet As String)
 
Dim Wb As Workbook
Dim Sh As Worksheet
Dim I As Long, NbColonnes As Long
 
 
    Set Wb = Workbooks.Open(CheminComplet)
    Set Sh = Wb.Sheets("Sheet1")
 
    With Sh
 
       NbColonnes = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
 
       For I = NbColonnes To 1 Step -1
          If WorksheetFunction.CountA(.Cells(1, I).EntireColumn) = 0 Then .Cells(1, I).EntireColumn.Delete
       Next I
 
       NbColonnes = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
       .UsedRange.Copy Destination:=ShCible.Range("A20")
 
    End With
 
    Set Wb = Nothing
    Set Sh = Nothing
 
End Sub

[Philippe Tulliez]

Bonjour,
Le titre de la discussion est "Supprimer des colonnes vides" or dans ta procédure nommée CleanTable, tu fais bien d'autres choses

Voici une procédure qui peut encore être améliorée qui supprime toutes les colonnes vides d'une feuille quelconque (précisé par l'argument oSheet

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub ClearEmptyColumns(oSheet As Worksheet)
  Dim rng As Range
  Dim c As Integer
 
  With oSheet
   For c = .Columns.Count To 1 Step -1
      If Application.CountA(.Columns(c)) = 0 Then .Columns(c).Delete
   Next
  End With
End Sub

Exemple d'une procédure qui l'invoque

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub TestClearColumn()
  Application.ScreenUpdating = False
  ClearEmptyColumns ThisWorkbook.Worksheets("Feuil4")
End Sub

[bzh.floriane]

Merci pour vos messages, j'ai essayé d'appliquer cela à mon cas. N'arrivant pas dans mon cas à ce que la fonction ClearEmptyColumns prenne un WorkSheet en argument, j'ai préféré lui donner une Range en argument. Comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub ClearEmptyColumns(TableFind As Range)
    Dim rng As Range
    Dim c As Integer
 
    With TableFind
     For c = .Columns.Count To 1 Step -1
        If Application.CountA(.Columns(c)) = 0 Then .Columns(c).Delete
     Next
    End With
End Sub

Mais cela supprimer les colonnes sur mon fichier Classeur_travail tandis que j'aimerai copier ce tableau sans colonne vide dans une autre feuille sans modifier l'original.
Voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Set TableFind = Workbooks("Classeur_travail.xlsx").Worksheets("Sheet2").Cells(CellFind.Row + 1, 1).Resize(Ln, 1).EntireRow
        Application.ScreenUpdating = False
    ClearEmptyColumns TableFind

Est-il possible que la fonction ClearEmptyColumns retourne ce tableau ?

Merci d'avance

[bzh.floriane]

Ou est-il possible d'adapter cette fonction pour qu'elle prenne un Range en argument ?

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 EffacerLesColonnes(ByVal ShCible As Worksheet, ByVal CheminComplet As String)
 
Dim Wb As Workbook
Dim Sh As Worksheet
Dim I As Long, NbColonnes As Long
 
 
    Set Wb = Workbooks.Open(CheminComplet)
    Set Sh = Wb.Sheets("Sheet1")
 
    With Sh
 
       NbColonnes = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
 
       For I = NbColonnes To 1 Step -1
          If WorksheetFunction.CountA(.Cells(1, I).EntireColumn) = 0 Then .Cells(1, I).EntireColumn.Delete
       Next I
 
       NbColonnes = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
       .UsedRange.Copy Destination:=ShCible.Range("A20")
 
    End With
 
    Set Wb = Nothing
    Set Sh = Nothing
 
End Sub

[Invité]

Bonjour,

On parlera de procédure plutôt que de fonction.

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
 
Sub EffacerLesColonnes(ByVal ShCible As Worksheet, ByVal CheminComplet As String)
 
Dim Wb As Workbook
Dim I As Long, NbColonnes As Long
 
 
    Set Wb = Workbooks.Open(CheminComplet)
 
    With ShCible
 
         Wb.Sheets("Sheet1").UsedRange.Copy Destination:=.Range("A20")
         NbColonnes = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
 
         For I = NbColonnes To 1 Step -1
             If WorksheetFunction.CountA(.Cells(1, I).EntireColumn) = 0 Then .Cells(1, I).EntireColumn.Delete
         Next I
 
    End With
 
    Set Wb = Nothing
 
 
End Sub

[bzh.floriane]

Merci beaucoup, cela fonctionne