Discussion :

[mjdcm]

Bonjour à tous,

Nouveau sur le forum et novice en VBA, j'ai un besoin concernant une macro que je n'arrive pas à réaliser.
J'espère que vous pourrez m'aider

J'ai un tableau dans un onglet "BDD", je souhaite ne conserver que certaines lignes et certaines colonnes pour les coller dans un onglet "NEW".
Pour cela, en colonne A je marque d'une coche "x", l'ensemble des lignes que je souhaite conserver.
Puis en ligne 1, je marque d'une coche "x" l'ensemble des colonnes que je souhaite conserver.

La macro doit :

1. Supprimer l'ensemble du contenu de l'onglet "NEW"

2. Copier/coller l'ensemble du contenu de l'onglet "BDD" dans l'onglet "NEW"

3. Supprimer les lignes qui n'ont pas de coche en colonne A.

4. Supprimer les colonnes qui n'ont pas de coche en ligne 1.


J'aimerais que cette macro soit dynamique, que je puisse rajouter ou supprimer une coche en colonne A ou ligne 1.

Voici un fichier pour mieux comprendre. FichierTestsVBA.xlsm
Dans l'onglet "BDD" le tableau de base.
Et le résultat que je souhaite avoir est dans l'onglet "NEW".

Pouvez-vous m'aider pls ?
Merci

[ARTURO83]

Bonjour,

Se mettre sur la feuille BDD pour lancer la macro
le 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
16
17
18
19
20
21
22
23
24
Option Compare Text
 
Sub Recup_Selection()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, DerCol_f1 As Long
 
    Application.ScreenUpdating = False
    Set f1 = Sheets("BDD")
    Set f2 = Sheets("NEW")
 
    DerLig_f1 = f1.[A100000].End(xlUp).Row
    DerCol_f1 = [Xfd1].End(xlToLeft).Column    
    f2.Cells.Clear
    f1.Range(Cells(1, 1), Cells(DerLig_f1, DerCol_f1)).Copy Destination:=f2.Cells(1, 1)
    For i = DerLig_f1 To 3 Step -1
        If f2.Cells(i, "A") = "" Then f2.Cells(i, "A").EntireRow.Delete
    Next i
    For i = DerCol_f1 To 3 Step -1
        If f2.Cells(1, i) = "" Then f2.Cells(1, i).EntireColumn.Delete
    Next i
 
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Autre méthode

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
Option Compare Text
 
Sub Recup_Selection()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, DerCol_f1 As Long
 
    Application.ScreenUpdating = False
    Set f1 = Sheets("BDD")
    Set f2 = Sheets("NEW")
 
    DerLig_f1 = f1.[A100000].End(xlUp).Row
    DerCol_f1 = [Xfd1].End(xlToLeft).Column
    f2.Cells.Clear
    Rows("1:1").Select
    If f1.AutoFilterMode Then
        isOn = "On"
    Else
        isOn = "Off"
        Selection.AutoFilter
    End If
    f1.Range(Cells(1, "A"), Cells(DerLig_f1, DerCol_f1)).AutoFilter Field:=1, Criteria1:="<>"
    f1.Range(Cells(1, "A"), Cells(DerLig_f1, DerCol_f1)).SpecialCells(xlVisible).Copy Destination:=f2.Cells(1, 1)
    For i = DerCol_f1 To 3 Step -1
        If f2.Cells(1, i) = "" Then f2.Cells(1, i).EntireColumn.Delete
    Next i
    f1.Rows("1:1").AutoFilter
 
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Cdlt

[mjdcm]

Super merci Arturo83 ça fonctionne parfaitement