XL 2010 Bordure automatique VBA

[anass1]

Bonjour
je voudrai définir une Bordure automatique aux cellules lors de l'exportation dans un autre classeur avec du code VBA
merci

With Application.Workbooks.Add
Application.Visible = True
Dim chosename
chosename = InputBox("Veuillez nommer la feuil:", "Nommer la nouvelle feuil")
'If chosename = "" Then Exit Sub
Sheets(1).Name = chosename & " ;" & Format(Now(), "dd-mm-yyyy")
temp.Range("z1:ah1").Copy Sheets(1).Range("a1:I1")
Sheets(1).Range("a1:I1").ColumnWidth = 14
Dim lastrow
lastrow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
For v = 0 To Me.ListBox1.ListCount - 1
Cells(lastrow, 1).Value = Me.ListBox1.List(v, 0)
Cells(lastrow, 2).Value = Me.ListBox1.List(v, 1)
Cells(lastrow, 3).Value = Me.ListBox1.List(v, 2)
Cells(lastrow, 4).Value = Me.ListBox1.List(v, 3)
Cells(lastrow, 5).Value = Me.ListBox1.List(v, 4)
Cells(lastrow, 6).Value = Me.ListBox1.List(v, 5)
Cells(lastrow, 7).Value = Me.ListBox1.List(v, 6)
Cells(lastrow, 8).Value = Me.ListBox1.List(v, 7)
lastrow = lastrow + 1
Next
MsgBox "Export réalisé avec succès"
End With

 

[vmax01]

bonjour anass1, le forum,

je te repasse ton code avec la modification.

Private Sub CommandButton3_Click()
With Application.Workbooks.Add
Application.Visible = True
Dim chosename
chosename = InputBox("Veuillez nommer la feuil:", "Nommer la nouvelle feuil")
'If chosename = "" Then Exit Sub
Sheets(1).Name = chosename & " ;" & Format(Now(), "dd-mm-yyyy")
temp.Range("z1:ah1").Copy Sheets(1).Range("a1:I1")
Sheets(1).Range("a1:I1").ColumnWidth = 14
Dim lastrow
lastrow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
For v = 0 To Me.ListBox1.ListCount - 1
    Cells(lastrow, 1).Value = Me.ListBox1.List(v, 0)
    Cells(lastrow, 3).Value = Me.ListBox1.List(v, 2)
    Cells(lastrow, 4).Value = Me.ListBox1.List(v, 3)
    Cells(lastrow, 5).Value = Me.ListBox1.List(v, 4)
    Cells(lastrow, 6).Value = Me.ListBox1.List(v, 5)
    Cells(lastrow, 7).Value = Me.ListBox1.List(v, 6)
    Cells(lastrow, 8).Value = Me.ListBox1.List(v, 7)
    With Range(Cells(lastrow, 1), Cells(lastrow, 8))
        .Borders.LineStyle = xlContinuous
    End With
    lastrow = lastrow + 1
Next
MsgBox "Export réalisé avec succès"
End With
End Sub

bonne journée

 

[anass1]

Merci bcp vmax01
Bonne journée