VBA Conso d'onglets

[FAUB]

Bonjour le forum,

J'utilise la macro suivante (prise sur le site de Mr Boisgontier) pour rappatrier les onglets "Base" de différents classeur dans un même classeur.

Sub Rappatrier_Onglets_Click()
Dim fileName As String, nbFiles As Integer, curfile, curWbk As Workbook, FD As FileDialog
Set FD = Application.FileDialog(msoFileDialogFilePicker)
FD.AllowMultiSelect = True
FD.Filters.Clear
FD.Filters.Add Description:="Excel Files", Extensions:="*.xls;*.xlsx"
FD.Show
For Each curfile In FD.SelectedItems
Set curWbk = Application.Workbooks.Open(fileName:=curfile)
curWbk.Sheets("Base").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
curWbk.Close savechanges:=False
Next curfile
End Sub



J'aimerais que lorsque les onglets sont copiés dans le nouveau classeur, ils soient renommés avec le nom de leur fichier d'origine.

Savez-vous qu'est-ce que je dois ajouter ?
Merci d'avance.

FAUB

 

[maninweb]

Re : VBA Conso d'onglets

Bonjour...

essaye ceci...

Set curWbk = Application.Workbooks.Open(fileName:=curfile)
curWbk.Sheets("Base").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = curWbk.Name ' Ajouter à ton code

curWbk.Close savechanges:=False

Salut

 

[FAUB]

Re : VBA Conso d'onglets

Ca marche nickel merci.
Par contre dans le nom se met également l'extension ".xls". Y a t il un moyen de l'enlever ?

FAUB

 

[mromain]

Re : VBA Conso d'onglets

salut FAUB, maninweb

essaye avec
Left(curWbk.Name, Len(curWbk.Name) - 4)

a+

 

[FAUB]

Re : VBA Conso d'onglets

Ca marche aussi très bien, merci mromain.

Dernière chose, lorsque j'utilise cette macro, les onglets sont rappatriés avec des formules. Comment pourrais-je les coller en Valeur ?

Merci pour votre aide.

 

[mromain]

Re : VBA Conso d'onglets

re,

à tester :

Set curWbk = Application.Workbooks.Open(Filename:=curfile)
curWbk.Sheets("Base").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    .Name = Left(curWbk.Name, Len(curWbk.Name) - 4)
    .Cells.Copy
    .Cells.PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
End With
curWbk.Close savechanges:=False

a+

 

[FAUB]

Re : VBA Conso d'onglets

Très bien aussi.
Parfois les "Bases" sont filtrées. Quelle ligne puis-je ajouter pour défiltrer le tableau avant de faire le copier collage valeur, sans que la macro bloque quand il n'y a pas de filtre activé ?

Merci bcp !

FAUB

 

[mromain]

Re : VBA Conso d'onglets

bonjour FAUB,

si j'ai bien compris :

Sub t()
Set curWbk = Application.Workbooks.Open(Filename:=curfile)
curWbk.Sheets("Base").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    .Name = Left(curWbk.Name, Len(curWbk.Name) - 4)
    .Cells.AutoFilter
    .Cells.Copy
    .Cells.PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
End With
curWbk.Close savechanges:=False
End Sub

a+