Modif 1 param. - macro de bebere - recup file

VBA_DEAD · 18 Décembre 2006

Bonjour le forum, et bonjour bebere

je lui dit bonjuor car il m`a trop aide sur le fil ci dessous

https://www.excel-downloads.com/threads/presque-fini-transfert-feuilles-files.70546/

La macro va chercher ds des files fermes les feuilles "Cash position" et les reunis ds 1 seul fichier en reprenant le nom du file comme nom de l`onglet.
Mon probleme est que mes files ont un nom trop long donc le nom n`est pas repris ds l`onglet quand je reunis toutes mes feuilles "Cash position".

Comment dire a la macro que le nom de l`onglet doit etre le premier terme du fichier :

par exemple mon file s`appelle BOUBOG - xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx et un autre FEAR - YYYYYYYYYYYYYYYYYYY, comment dire a la macro que je veux le terme a gauche du " -"?? donc 1 onglet BOUBOG et un autre FEAR??

ci-dessous le code de cette superbe macro

Private Sub selection_Click()
Dim I As Integer, S As Byte
Dim WkSource As Workbook, WkDest As Workbook
Dim Nom As String

Dim iSheets As Integer 'nbre feuille dans nouveau classeur
With Application
iSheets = .SheetsInNewWorkbook
.SheetsInNewWorkbook = 1
.ScreenUpdating = False 'true
.DisplayAlerts = False 'true
End With
Set WkDest = Workbooks.Add
Application.SheetsInNewWorkbook = iSheets

With liste
For I = 0 To .ListCount - 1
Nom = .List(I, 0) 'liste.Value

Set WkSource = Workbooks.Open(Filename:=NomDossier & Nom)
For S = 1 To Sheets.Count
If Left(Sheets(S).Name, 13) = "CASH POSITION" Then
If I = 0 Then
WkSource.Sheets(S).Cells.Copy Destination:=WkDest.Sheets(1).Cells(1, 1)
WkDest.Sheets(1).Name = Nom
Else:
WkDest.Activate
Sheets.Add.Move After:=Sheets(Sheets.Count)
WkSource.Sheets(S).Cells.Copy Destination:=WkDest.Sheets(Sheets.Count).Cells(1, 1)
WkDest.Sheets(Sheets.Count).Name = Nom
End If
Exit For
End If
Next S

'Set Rng = Nothing
WkSource.Close
Next I
End With

WkDest.SaveAs Filename:=NomDossier & "Total" & Left(Nom, 2)
WkDest.Close

With Application
.ScreenUpdating = True ' False
.DisplayAlerts = True 'False
End With

End Sub

merci pour votre aide... ou merci Bebere si tu rodes!

A+

VBA_DEAD

Creepy · 18 Décembre 2006

Re : Modif 1 param. - macro de bebere - recup file

Bonsoir,

Si j'ai bien compris le code sans exemple c'est un peu dur, mais je pense que je suis bon, met ca :

With liste
For I = 0 To .ListCount - 1
Nom = .List(I, 0)
Nom = Mid$(Nom, 1, InStr(1, Nom, "-") - 2)

-2 car je crois qu'il y a toujours un espace devant le "-", sinon -1

A +

Creepy

VBA_DEAD · 18 Décembre 2006

Re : Modif 1 param. - macro de bebere - recup file

Bonsoir Creepy
merci de ton aide

j`essaie cela demain et te reviens

bonne soiree

VBA_DEAD

VBA_DEAD · 19 Décembre 2006

Re : Modif 1 param. - macro de bebere - recup file

Re bonjour Creepy et le forum

ben ca marche pas... mais c`est jsuet apres que ca plante et ca vient du changement.

peux tu m`aider? je t`ai fait un exemple

Pour info : La macro ajoute un bouton ds la barre d`outil

ensuite tu colles tout ds 1 folder, tu lances la macro Macro Group en laissant les files fermes.

cava aller chercher les feuilles "Cash" de ces files fermes mais je voudrais donc que le nom de l`onglet recupere reprenne le nom du fichier (mais juste la partie a gauche...

Merci de ton aide et encore merci bebere...

VBA_dead

Bebere · 19 Décembre 2006

Re : Modif 1 param. - macro de bebere - recup file

bonjour vbadead,creepy

comme ceçi
Nom= Left(Nom, InStr(1, Nom, "-") - 2)
'ou seulement si Nom plus grand que 31
if Nom>31 then Nom=Left(Nom, InStr(1, Nom, "-") - 2)
à bientôt

Creepy · 20 Décembre 2006

Re : Modif 1 param. - macro de bebere - recup file

RE All,

C'est normal que tu est une erreur ! Ton code attribue à la variable nom le nom du fichier. Moi juqte après je tronquais ce nom pour n'avoir que la partie gauche du nom, avant le "-".

La ligne juste en dessous tu ouvres le ficheir avec comme paramètre la varaibles nom. Mais comme je l'ai tronqué le fichier existe pas !!

Il faut donc mettre mon code après dans la procédure pour que cela fonctionne !

Voici le code :

Code:

Private Sub selection_Click()
Dim NB_List As Integer, NB_Sheet As Byte
Dim WkSource As Workbook, WkDest As Workbook
Dim Nom As String
Dim iSheets As Integer 'nbre feuille dans nouveau classeur
With Application
    iSheets = .SheetsInNewWorkbook
    .SheetsInNewWorkbook = 1
    .ScreenUpdating = False 'true
    .DisplayAlerts = False 'true
End With
Set WkDest = Workbooks.Add
Application.SheetsInNewWorkbook = iSheets
With liste
    For NB_List = 0 To .ListCount - 1
        Nom = .List(NB_List, 0) 'liste.Value
        Set WkSource = Workbooks.Open(Filename:=NomDossier & Nom)
        For NB_Sheet = 1 To Sheets.Count
          If Left(Sheets(NB_Sheet).Name, 4) = "Cash" Then
              If NB_List = 0 Then
                  WkSource.Sheets(NB_Sheet).Cells.Copy Destination:=WkDest.Sheets(1).Cells(1, 1)
                  Nom = Mid$(Nom, 1, InStr(1, Nom, "-") - 2)
                  If Len(Nom) > 31 Then Nom = Mid$(Nom, 1, 31)
                  WkDest.Sheets(1).Name = Nom
              Else
                  WkDest.Activate
                  Sheets.Add.Move After:=Sheets(Sheets.Count)
                  WkSource.Sheets(NB_Sheet).Cells.Copy Destination:=WkDest.Sheets(Sheets.Count).Cells(1, 1)
              End If
              Exit For
          End If
        Next NB_Sheet
      WkSource.Close
    Next NB_List
End With
WkDest.SaveAs Filename:=NomDossier & "Total" '& Left(Nom, 2)
WkDest.Close
  
With Application
    .ScreenUpdating = True ' False
    .DisplayAlerts = True 'False
End With
Set WkDest = Nothing
Set WkSource = Nothing
End Sub

Au passage ton code est vraiment comme dire ... chiant à lire. Pas d'identation propre des for, if, etc ...
Variables I, S, Z etc ...
Pas de set xx = nothing à la fin,
Etc ...

Bref pour moi qui n'ai pas bcp de temps en ce moment, il m'a fallut un peu de temps pour ré-ordonner tout ca, avant de comprendre la logique.

Essaie d'organiser mieux ton code, imagine quand tu le reprendras dans 1,5 ans !

A+

Creepy

VBA_DEAD · 20 Décembre 2006

Re : Modif 1 param. - macro de bebere - recup file

Salut CREEPY et Bebere

ne dit pas que le code n`est pas facile a lire stp! C`est bebere qui l`a fait, la macro fonctionne bien donc deja je t`assure que je suis le + heureux.

CREEPY ta formulation marche pour le 1er onglet mais apres ca cale!

ca vient d`ou?

enfin faut se dire que l`on chauffe!! je sens que la soluce est proche LOL

VBA_DEAD

Modif 1 param. - macro de bebere - recup file

VBA_DEAD

XLDnaute Occasionnel

Creepy

XLDnaute Accro

VBA_DEAD

XLDnaute Occasionnel

VBA_DEAD

XLDnaute Occasionnel

Pièces jointes

Bebere

XLDnaute Barbatruc

Creepy

XLDnaute Accro

VBA_DEAD

XLDnaute Occasionnel

Discussions similaires