Bonjour la communauté,
Je suis tombé sur notre forum sur un sujet qui me serait très utile.
Toutefois, je souhaite réutiliser la macro mais celle-ci est très complexe pour mon niveau de débutant.
Pourriez-vous m'aider à la déchiffrer afin que je puisse la réutiliser ?
---------------------
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim rng As Range
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Me.ListObjects(1).ListColumns(9).DataBodyRange) Is Nothing Then
Application.ScreenUpdating = False
Set ws = ActiveWorkbook.Worksheets("Adhérents")
With ws.ListObjects(1)
If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
End With
If Me.ListObjects(1).ShowAutoFilter Then
If Me.ListObjects(1).AutoFilter.FilterMode Then Me.ListObjects(1).AutoFilter.ShowAllData
Else
Me.ListObjects(1).ShowAutoFilter = True
End If
Me.ListObjects(1).Range.AutoFilter field:=9, Criteria1:="x"
With Me.ListObjects(1).AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count - 4) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng Is Nothing Then
MsgBox "Pas de données à copier"
Else
rng.Copy
ws.Cells(4, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
Me.ListObjects(1).Range.AutoFilter field:=9
End If
Set rng = Nothing
End Sub
----------------------
L'idée est qu'au lieu que la colonne qui permet de recopier via la croix "X" ne soit plus la colonne I mais la A et qu'à la place de recopier que quelques colonnes je souhaiterais ragrandir le nombre de colonnes recopiées : A à H aujourd'hui à B à S par exemple. Pouvez-vous me guider ?
Par la même occasion, est-ce possible de faire ce type de macro sur sheet ?
Un grand merci par avance,
Quentin
Je suis tombé sur notre forum sur un sujet qui me serait très utile.
Toutefois, je souhaite réutiliser la macro mais celle-ci est très complexe pour mon niveau de débutant.
Pourriez-vous m'aider à la déchiffrer afin que je puisse la réutiliser ?
---------------------
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim rng As Range
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Me.ListObjects(1).ListColumns(9).DataBodyRange) Is Nothing Then
Application.ScreenUpdating = False
Set ws = ActiveWorkbook.Worksheets("Adhérents")
With ws.ListObjects(1)
If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
End With
If Me.ListObjects(1).ShowAutoFilter Then
If Me.ListObjects(1).AutoFilter.FilterMode Then Me.ListObjects(1).AutoFilter.ShowAllData
Else
Me.ListObjects(1).ShowAutoFilter = True
End If
Me.ListObjects(1).Range.AutoFilter field:=9, Criteria1:="x"
With Me.ListObjects(1).AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count - 4) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng Is Nothing Then
MsgBox "Pas de données à copier"
Else
rng.Copy
ws.Cells(4, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
Me.ListObjects(1).Range.AutoFilter field:=9
End If
Set rng = Nothing
End Sub
----------------------
L'idée est qu'au lieu que la colonne qui permet de recopier via la croix "X" ne soit plus la colonne I mais la A et qu'à la place de recopier que quelques colonnes je souhaiterais ragrandir le nombre de colonnes recopiées : A à H aujourd'hui à B à S par exemple. Pouvez-vous me guider ?
Par la même occasion, est-ce possible de faire ce type de macro sur sheet ?
Un grand merci par avance,
Quentin
