Bonjour,
Je sollicite votre aide pour un programme VBA pour copier et coller avec mise en forme. ce programme doit être ajouté au code vba suivant :
Option Explicit
Dim tablo, dico, i, j, k, t, ln, v(), fdep, f
Sub CréerLesDossiers()
tablo = Range(Cells(1, 1), Cells(Range("A" & Rows.Count).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
Set dico = CreateObject("Scripting.Dictionary")
Set fdep = ActiveSheet
Sheets.Add
Set f = ActiveSheet
fdep.Select
For i = 2 To UBound(tablo, 1)
dico(tablo(i, 1)) = ""
Next i
k = dico.keys
For i = 0 To dico.Count - 1
'MsgBox k(i)
ln = 0
For t = 2 To UBound(tablo, 1)
If k(i) = tablo(t, 1) Then
ReDim Preserve v(UBound(tablo, 2), ln + 1)
For j = 1 To UBound(tablo, 2)
v(j - 1, ln) = tablo(t, j)
Next j
ln = ln + 1
End If
Next t
f.Cells.Clear
Rows("1:1").Copy f.Range("A1")
f.Range("A2").Resize(UBound(v, 2), UBound(v, 1)) = Application.Transpose(v)
f.Copy
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\" & " " & k(i)
.Close
End With
Next i
'f.Cells.Clear
f.Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
MsgBox "Travail terminé."
End Sub
Sub Macro1()
'
' Macro1 Macro
'
'
Sheets("Feuil7").Select
ActiveWindow.SelectedSheets.Delete
End Sub
Le code en dessus a pour but de créer des classeurs a partir de cellule A1, A2,A3.... pour moi j'ai besoin que chaque classeur créer a le contenu de classeur ci joint avec la même mise en forme. Merci en avance.