Coller une ligne à la dernière ligne d'un autre classeur
Bonjour,
Je reviens vers vous puisque je rencontre un autre petit soucis. Je souhaite coller la ligne 2 du classeur code.xls à la fin du tableau base.xls
J'avais écris ce code ci :
Code Visual Basic :
Option Explicit
Function Ajout_Base()
Dim Plage As Range
Dim Cellule As Range
'Ouverture du classeur base.xls
Workbooks.Open Filename:= _
"C:\ptc_config\config_perso_wf2\Macros_Articles\code_xls\base.xls"
'Insertion d'une nouvelle ligne
Workbooks("base.xls").Worksheets("Feuil1").Rows("3:3").Insert Shift:=xlDown
'Copier de la ligne 2 du classeur code.xls vers la ligne 3 de base.xls
Workbooks("code.xls").Worksheets("Feuil1").Range("A2:H2").Copy Destination:=Workbooks("base.xls").Worksheets("Feuil1").Range("A3")
'Effacer les A du format
Set Plage = Range("D3:D200")
For Each Cellule In Plage
Cellule.Value = Replace(Cellule.Value, "A", "")
Next Cellule
'Effacer les espaces de base.xls.
Call SupprEspaces 'Module 4
'Effacer les caractères (ï>>¿) BOM (UTF_8)
Call SupprimerCar 'Module 5
End Function
Ce code permettait d'insérer une nouvelle ligne à la ligne 3 du tableau. Le problème c'est que le classeur excel dispose d'une mise en forme conditionnelle, à chaque insertion de ligne cette mise en forme est donc perdu.
Donc 2 possibilités s'offre à moi:
- Soit je trouve une solution pour insérer une ligne en début de tableau en gardant le format.
- Soit je détecte la dernière ligne du tableau et je colle cette fameuse ligne.
Je préférerai quand même la première solution mais je ne sais pas si c'est possible de faire cela.
A savoir que les tableaux ne sont pas délimités, Il n'y a qu'un seul tableau dans la feuille du classeur.
Merci d'avance !
Bonjour Azertym,
En gardant ta première solution, essayes comme ceci
Sub Ajout_Base()
Dim Plage As Range
Dim Cellule As Range
'Ouverture du classeur base.xls
Workbooks.Open Filename:= _
"C:\ptc_config\config_perso_wf2\Macros_Articles\code_xls\base.xls"
'Insertion d'une nouvelle ligne sans MFC
Workbooks("base.xls").Worksheets("Feuil1").Rows("3:3").Insert Shift:=xlDown
'Copier de la ligne 2 du classeur code.xls vers la ligne 3 de base.xls
Workbooks("code.xls").Worksheets("Feuil1").Range("A2:H2").Copy Destination:=Workbooks("base.xls").Worksheets("Feuil1").Range("A3")
' Copier coller la MFC de la ligne du dessous
Workbooks("base.xls").Worksheets("Feuil1").Range("A4").Copy
Workbooks("base.xls").Worksheets("Feuil1").Range("A3").PasteSpecial Paste:=xlPasteFormats
'Effacer les A du format
Set Plage = Range("D3:D200")
For Each Cellule In Plage
Cellule.Value = Replace(Cellule.Value, "A", "")
Next Cellule
'Effacer les espaces de base.xls.
Call SupprEspaces 'Module 4
'Effacer les caractères (ï>>¿) BOM (UTF_8)
Call SupprimerCar 'Module 5
End Sub
En revanche pourquoi utiliser une fonction ?
Tu ne retournes aucune valeur
A+
nickel ca fonctionne cependant j'ai du modifier quelque petite choses :
Sub Ajout_Base()
Dim Plage As Range
Dim Cellule As Range
'Ouverture du classeur base.xls
Workbooks.Open Filename:= _
"C:\ptc_config\config_perso_wf2\Macros_Articles\code_xls\base.xls"
'Insertion d'une nouvelle ligne sans MFC
Workbooks("base.xls").Worksheets("Feuil1").Rows("3:3").Insert Shift:=xlDown
' Copier coller la MFC de la ligne du dessous
Workbooks("base.xls").Worksheets("Feuil1").Range("A5").Copy
Workbooks("base.xls").Worksheets("Feuil1").Range("A3").PasteSpecial Paste:=xlPasteFormats
'Copier de la ligne 2 du classeur code.xls vers la ligne 3 de base.xls
Workbooks("code.xls").Worksheets("Feuil1").Range("A2:H2").Copy
Workbooks("base.xls").Worksheets("Feuil1").Range("A3").PasteSpecial Paste:=xlPasteValues
'Effacer les A du format
Set Plage = Range("D3:D200")
For Each Cellule In Plage
Cellule.Value = Replace(Cellule.Value, "A", "")
Next Cellule
'Effacer les espaces de base.xls.
Call SupprEspaces 'Module 4
'Effacer les caractères (ï>>¿) BOM (UTF_8)
Call SupprimerCar 'Module 5
End Sub
Je crois que le problème venait du fait qu'il copiait tout le format du fichier code.xls, j'ai donc du forcer la copie des valeurs uniquement.
En tout cas merci de ton aide !