grouper (OK) et recuperer nom feuille (pas OK)??

[VBA_DEAD]

Bonjour a tous,

j`essaie de regrouper des donnees ds differents onglets mais comment recuperer pour chaque ligne le nom de l`onglet
je bloque.

j`ai fait un petit exemple pour etre plus clair
merci a vous pour votre aide

VBA-DEAD

 

[kikouyou]

Re : grouper (OK) et recuperer nom feuille (pas OK)??

salut vba dead,

je sais pas si g tt saisi mais :

Dim vNom1 as string

ActiveSheet.Name = vNom1

le code suivant te permets de récupérer le nom de la feuille active dans la variable vNom1.

ce qu'il faut faire ensuite c'est que dans une range à coté des lignes concernées tu fasses apparaitre vNom1.....

 

[kikouyou]

Re : grouper (OK) et recuperer nom feuille (pas OK)??

sinon tu peux contourner ton probleme, tu peux ainsi dans chaque onglet tu peux ds ttes les cellules de la colonne A le nom de ton onglet puis le mettre en blanc...

 

[kikouyou]

Re : grouper (OK) et recuperer nom feuille (pas OK)??

essaie peut etre ca aussi, avec la fonction indirect, si tes noms d'onglets sont figés cela peut être intéressant....

 

[vbacrumble]

Re : grouper (OK) et recuperer nom feuille (pas OK)??

Bonjour


Essaie ces modifications (Un problème persiste)

Si tu trouves le pourquoi , fais moi signe

Sub Group()
Dim plg As Range
Dim l As Long
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "SUMMARY" Then
    
      With Ws
      Set plg = Ws.Range("A2:B" & Ws.Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeConstants)
      l = plg.Rows.Count
      plg.Copy
        With Sheets("SUMMARY").Range("A65536")
            With .End(xlUp)
                .Offset(1, 0).PasteSpecial xlValues
                .Offset(1, 2).Resize(l, 1).Value = Ws.Name
            End With
            End With
    Application.CutCopyMode = False
End With
    End If
Next
'Call TRI
End Sub

 

[VBA_DEAD]

Re : grouper (OK) et recuperer nom feuille (pas OK)??

bonsoir VBACRUMBLE et KIKOUYOU

j`ai teste le code mais ca ne fait pas exactement ce que je cherche
ca n`ajoute las le nom sur certaines lignes car j`ai des lignes vides au milleu

de + , ca rajoute les donnees de la feuille SUMMARY 1 deuxieme fois..


je vais creuser encore

merci

vba_dead

 

[vbacrumble]

Re : grouper (OK) et recuperer nom feuille (pas OK)??

Re



J'avais prévenu

Essaie ces modifications (Un problème persiste)

 

[Pierrot93]

Re : grouper (OK) et recuperer nom feuille (pas OK)??

Bonsoir vba dead, vba crumble, kikouyou,

essaye peut être comme suit :

Option Explicit
Sub test()
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "SUMMARY" Then
        Ws.Range("[COLOR="Red"][B]A4[/B][/COLOR]:B" & Ws.Range("A65536").End(xlUp).Row).Copy _
            Sheets("SUMMARY").Range("A65536").End(xlUp).Offset(1, 0)
            Sheets("SUMMARY").Range("A65536").End(xlUp).Offset(0, 2).Value = Ws.Name
    End If
Next
End Sub

à tester..

bonne soirée
@+

Edition : modifié A2 en A4, a priori première ligne de tes données...

 

[VBA_DEAD]

Re : grouper (OK) et recuperer nom feuille (pas OK)??

bonjour

ben merci Pierrot mais ca ne marche pas non plus 🙁

ca ne reporte pas le nom de la feuille sur chaque ligne recuperee

merci quand meme

VBA_DEAD

 

[Pierrot93]

Re : grouper (OK) et recuperer nom feuille (pas OK)??

Re

essaye comme suit, mais attention dans ton fichier exemple, la feuille "info b" comporte des lignes blanches. Pour ce genre d'exercice il est préférable de construire son fichier comme une vrai base de donnée, une ligne de titre en ligne 1, lasuite des données au dessous sans ligne vide. Beaucoup plus facile à travailler ensuite... enfin c'est juste mon avis...

Option Explicit
Sub test()
Dim Ws As Worksheet
For Each Ws In Worksheets
    If Ws.Name <> "SUMMARY" Then
        Ws.Range("A4:B" & Ws.Range("A65536").End(xlUp).Row).Copy _
            Sheets("SUMMARY").Range("A65536").End(xlUp).Offset(1, 0)
            With Sheets("SUMMARY")
                .Range(.Range("C65536").End(xlUp).Offset(1, 0), .Range("C" & .Range("A65536").End(xlUp).Row)).Value = Ws.Name
            End With
    End If
Next
End Sub

bonne soirée
@+