Récupérer un titre dans macro VBA

[toline]

Bonjour à tous,

J'ai crée une macro qui me permet d'assembler des fichiers, dans le même onglet, à la suite les uns des autres.

Je cherche maintenant à récupérer, pour chacun des fichiers en question, le titre du fichier, et le coller dans la colonne K de mon fichier.

Je pensais donc utiliser la fonction titre = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) pendant mon code puis dire à Excel, colle le titre en K2 puis en K2+12 (nombre de lignes que je sélectionne dans mon fichier)...
Cependant, je n'arrive pas à lui formuler correctement. Pouvez-vous m'aider?

Voici mon code:
Sub Importfiles()
Application.DisplayAlerts = False
Set wbdest = ActiveWorkbook
Dim titre
ChDrive "C": ChDir "C:\Users\utilisateur\Documents\8 - CRO\2 - Standard\Test"
fichier = Dir("*.xls")
Do While fichier <> ""
Set wbsource = Workbooks.Open(fichier)
Set wksNewSheet = wbsource.Sheets("STATS")
wksNewSheet.Activate
wksNewSheet.Select

Range(Cells(8, 2), Cells(19, 11)).Select
Selection.Copy
wbdest.Activate
i = Range("A1048576").End(xlUp).Row
Cells(i + 1, 1).Select
ActiveSheet.Paste
wbsource.Close
fichier = Dir

titre = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
???

Loop

wbdest.Activate
Application.DisplayAlerts = True

End Sub

Bon week-end à tous

 

[Paf]

Re : Récupérer un titre dans macro VBA

Bonjour

juste avant Do While fichier <> "" rajouter : Lig = -10

juste après Do While fichier <> "" rajouter : Lig = Lig + 12

à la place de titre = .... mettre : wbdest.cells( Lig , 11 ) = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)


A+

 

[toline]

Re : Récupérer un titre dans macro VBA

Bonjour Paf,

Désolée pour le retard de réponse, le week-end m'a fait m'éloigner un peu d'Excel.

Pour en revenir à ma problématique, j'ai ajouté le code comme expliqué dans le message. Cependant, à l'éxécution de la macro, j'obtiens run-time error '438': Object doesn't support this property or method. Le blocage se produit à wbdest.cells( Lig , 11 ) = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)

J'ai essayé de me documenter sur cette fameuse erreur 438 mais je ne comprends pas en quoi cette ligne n'est pas supportée par Excel

Merci

Toline

 

[Paf]

Re : Récupérer un titre dans macro VBA

Re bonjour,

je ne devais pas être en forme quand j'ai commis la réponse. je vois qu'elle ne répond pas au problème !

Si je comprends bien on veut écrire en K2 puis K14 puis en K26(?) ... le nom des classeurs successivement ouverts.

Sub Importfiles()
 Dim titre
 Application.DisplayAlerts = False
 Set wbdest = ActiveWorkbook
 Set WSdest = wbdest.ActiveSheet

 Lig = -10
 ChDrive "C": ChDir "C:\Users\utilisateur\Documents\8 - CRO\2 - Standard\Test"
 fichier = Dir("*.xls")
 Do While fichier <> ""
     Lig = Lig + 12
    Set wbsource = Workbooks.Open(fichier)
    Set wksNewSheet = wbsource.Sheets("STATS")
 
    i = WSdest.Range("A" & Rows.Count).End(xlUp).Row
    wksNewSheet.Range(Cells(8, 2), Cells(19, 11)).Copy   WSdest.Cells(i + 1, 1)
 
    WSdest.range("K" & Lig) = Left(wbsource.Name, Len(wbsource.Name) - 4)

  
    wbsource.Close
    fichier = Dir
 Loop

 wbdest.Activate
 Application.DisplayAlerts = True
End Sub

Testé sur le classeur fourni.

A+

 

[toline]

Re : Récupérer un titre dans macro VBA

Merci c'est exactement ça!