Copie de lignes avec format dans VBA - VB/VBA/VBS - Programmation
MarshPosté le 20-06-2010 à 23:17:06
Bonjour,
'ai écrit du code pour générer un fichier excel via une macro, j'arrive bien à copier le contenu des cellules en appliquant la règle que je souhaite (filtre sur valeur de la 1èere colonne) mais je voudrais également conserver le format (largeur colonne, police, ...), comment dois je procéder ?
Voici mon code :
Sub Creation_fichier_partenaire(CodPar As String, FicPar As String) Dim xls As Excel.Application Dim xlsfeuille As Excel.Worksheet Dim xlsclasseur As Excel.Workbook Dim Num1, Num2 As Integer
Set xls = CreateObject("Excel.Application" ) Set xlsclasseur = xls.Workbooks.Add Set xlsfeuille = xlsclasseur.Worksheets(1)
xlsfeuille.Rows(1).Value = Worksheets("Fichier" ).Rows(1).Value xlsfeuille.Cells(2, 1).ColumnWidth = Worksheets("Fichier" ).Cells(2, 1).ColumnWidth Num1 = 2 Num2 = 2 Do While Worksheets("Fichier" ).Cells(Num1, 1) <> "" If Worksheets("Fichier" ).Cells(Num1, 1).Value = CodPar Then xlsfeuille.Rows(Num2).Value = Worksheets("Fichier" ).Rows(Num1).Value Num2 = Num2 + 1 End If Num1 = Num1 + 1 Loop xlsfeuille.Columns(1).Delete xlsclasseur.SaveAs ("E:\" + FicPar) xls.Application.Quit Set xls = Nothing
Marsh Posté le 20-06-2010 à 23:17:06
Bonjour,
'ai écrit du code pour générer un fichier excel via une macro, j'arrive bien à copier le contenu des cellules en appliquant la règle que je souhaite (filtre sur valeur de la 1èere colonne) mais je voudrais également conserver le format (largeur colonne, police, ...), comment dois je procéder ?
Voici mon code :
Sub Creation_fichier_partenaire(CodPar As String, FicPar As String)
Dim xls As Excel.Application
Dim xlsfeuille As Excel.Worksheet
Dim xlsclasseur As Excel.Workbook
Dim Num1, Num2 As Integer
Set xls = CreateObject("Excel.Application" )
Set xlsclasseur = xls.Workbooks.Add
Set xlsfeuille = xlsclasseur.Worksheets(1)
xlsfeuille.Rows(1).Value = Worksheets("Fichier" ).Rows(1).Value
xlsfeuille.Cells(2, 1).ColumnWidth = Worksheets("Fichier" ).Cells(2, 1).ColumnWidth
Num1 = 2
Num2 = 2
Do While Worksheets("Fichier" ).Cells(Num1, 1) <> ""
If Worksheets("Fichier" ).Cells(Num1, 1).Value = CodPar Then
xlsfeuille.Rows(Num2).Value = Worksheets("Fichier" ).Rows(Num1).Value
Num2 = Num2 + 1
End If
Num1 = Num1 + 1
Loop
xlsfeuille.Columns(1).Delete
xlsclasseur.SaveAs ("E:\" + FicPar)
xls.Application.Quit
Set xls = Nothing
End Sub
Merci d'avance pour vos réponses.
Cordialement,