W
wapit
Guest
J'eesaye de créer une macro dont le but est de copier des données d'une feuille excel vers une nouvelle feuille.
Le copier coller se fait en fonction de checkboxes, cad que la macro doit copier que la colonne dont la chekbox est cochée.
Je n'y arrive pas, voilà ma macro :
Sub FicheClient()
'
' FicheClient Macro
' Macro enregistrée le 30/06/03 par LAGOR
'
'
ActiveSheet.Shapes("Bouton 38").Select
Selection.Characters.Text = "Fiche client"
With Selection.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Rows("8:8").Select
Selection.AutoFilter
Dim MonCheck As Shape, MaColonne As Range
For Each MonCheck In ActiveSheet.Shapes
If MonCheck.FormControlType = xlCheckBox Then
If MonCheck.ControlFormat.Value = 1 Then
Set MaColonne = MonCheck.TopLeftCell.EntireColumn
MaColonne.AutoFilter Field:=1, Criteria1:="<>"
End If
End If
Next
Sheets("Paca").Select
Sheets.Add
ActiveSheet.Name = "Client"
Sheets("Client").Move After:=Sheets(2)
Sheets("Paca").Select
Selection.Copy
Sheets("Client").Select
Range("E1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Paca").Select
Columns("B:E").Select
Selection.Copy
Sheets("Client").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Buttons.Add(420, 24.75, 60.75, 27).Select
Selection.Characters.Text = "Supprimer"
Selection.OnAction = "SupprimerFicheClient"
With Selection.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("H14").Select
End Sub
Le copier coller se fait en fonction de checkboxes, cad que la macro doit copier que la colonne dont la chekbox est cochée.
Je n'y arrive pas, voilà ma macro :
Sub FicheClient()
'
' FicheClient Macro
' Macro enregistrée le 30/06/03 par LAGOR
'
'
ActiveSheet.Shapes("Bouton 38").Select
Selection.Characters.Text = "Fiche client"
With Selection.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Rows("8:8").Select
Selection.AutoFilter
Dim MonCheck As Shape, MaColonne As Range
For Each MonCheck In ActiveSheet.Shapes
If MonCheck.FormControlType = xlCheckBox Then
If MonCheck.ControlFormat.Value = 1 Then
Set MaColonne = MonCheck.TopLeftCell.EntireColumn
MaColonne.AutoFilter Field:=1, Criteria1:="<>"
End If
End If
Next
Sheets("Paca").Select
Sheets.Add
ActiveSheet.Name = "Client"
Sheets("Client").Move After:=Sheets(2)
Sheets("Paca").Select
Selection.Copy
Sheets("Client").Select
Range("E1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Paca").Select
Columns("B:E").Select
Selection.Copy
Sheets("Client").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Buttons.Add(420, 24.75, 60.75, 27).Select
Selection.Characters.Text = "Supprimer"
Selection.OnAction = "SupprimerFicheClient"
With Selection.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("H14").Select
End Sub