XL 2013 (RESOLU) Automatisation Copie Lignes Feuilles selon leurs nom

[chaelie2015]

Bonsoir Forum
J'ai une feuille nommée 'Matrice' qui contient une plage à renseigner de B3:AY52. J'ai également plusieurs feuilles nommées 'Item N° x' (où x est une valeur variant de 1 à 50). Dans chaque feuille 'Item N° x', il y a une ligne de données située dans la plage GL64:II64.
Je recherche un code VBA pour la feuille 'Matrice' qui va copier la ligne (GL64:II64) de chaque feuille 'Item N° x' dans la colonne correspondante de la feuille 'Matrice' en fonction du nom de la feuille 'Item N° x'. Par exemple, si j'ai deux feuilles nommées 'Item N°1' et 'Item N°2', les lignes (GL64:II64) de chaque feuille doivent être copiées dans les colonnes 'Item N°1' et 'Item N°2' de la feuille 'Matrice'. De plus, chaque fois qu'une nouvelle feuille commençant par 'Item N° x' est créée, je souhaite que sa ligne soit automatiquement ajoutée au tableau en fonction du numéro de l'item.

Merci d'avance pour votre aide

 

[job75]

Bonsoir chaelie2015,

Voyez cette macro dans le code de ThisWorkbook :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not LCase(Sh.Name) Like "item n°*" Then Exit Sub
Dim c As Range
Set c = Sheets("Matrice").[2:2].Find(Sh.Name, , xlValues, xlWhole)
If c Is Nothing Then
    Sh.[GL64].Resize(, 50).Clear
Else
    c(2).Resize(50).Copy
    Sh.[GL64].PasteSpecial xlPasteAll, Transpose:=True
    Application.CutCopyMode = 0
End If
Sh.[GL64].Select
End Sub

Bonne nuit.

 

[chaelie2015]

Bonjour JOB
Je vous remercie pour votre réponse.
Je souhaite réaliser l'opération inverse, c'est-à-dire transférer les données des feuilles 'Item N° x' vers la feuille 'Matrice'. Lorsque j'ai tenté d'ajouter une autre feuille nommée 'Item N°2', cela n'a pas fonctionné.
De plus, j'aimerais que le transfert automatique des données des feuilles 'Item N° x' soit effectué à chaque modification sur ces feuilles. vers la 'Matrice'


Merci.

 

[job75]

Bonjour chaelie2015, le forum,

Oui j'avais mal lu alors utilisez :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not LCase(Sh.Name) Like "item n°*" Then Exit Sub
Dim F As Worksheet, c As Range
Set F = Sheets("Matrice")
Set c = F.[2:2].Find(Sh.Name, , xlValues, xlWhole)
If c Is Nothing Then Set c = F.Cells(2, F.Columns.Count).End(xlToLeft)(1, 2): c = Sh.Name
c(2).Resize(50) = Application.Transpose(Sh.[GL64].Resize(, 50))
End Sub

Private Sub Workbook_SheetDeActivate(ByVal Sh As Object)
Workbook_SheetChange Sh, Sh.[A1] 'lance la macro
End Sub

A+

 

[job75]

Le code précédent ne copie pas les formats, celui-ci le fait :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not LCase(Sh.Name) Like "item n°*" Then Exit Sub
Dim F As Worksheet, c As Range, n
Set F = Sheets("Matrice")
Set c = F.[2:2].Find(Sh.Name, , xlValues, xlWhole)
Application.ScreenUpdating = False
If c Is Nothing Then Set c = F.Cells(2, F.Columns.Count).End(xlToLeft)(1, 2): c = Sh.Name
With Sh.[GL64]
    For n = 1 To 50
        .Cells(1, n).Copy c(1 + n)
    Next
End With
End Sub

Private Sub Workbook_SheetDeActivate(ByVal Sh As Object)
Workbook_SheetChange Sh, Sh.[A1] 'lance la macro
End Sub

 

[chaelie2015]

Bonjour Job
Merci, c'est exactement ce que je cherchais.
A+

 

[chaelie2015]

Bonjour pour tous
Je souhaite améliorer mon fichier en ajoutant la condition suivante :
si la feuille nommée "Item N° x" est supprimée du classeur, alors vider la colonne correspondante dans la feuille "Matrice".
Par exemple, si je supprime la feuille "Item N°3" du classeur, alors automatiquement toutes les valeurs de la colonne "Item N°3" de la feuille "Matrice" seront effacées.
Merci

 

[job75]

si la feuille nommée "Item N° x" est supprimée du classeur, alors vider la colonne correspondante dans la feuille "Matrice".

Ajoutez cette macro dans ThisWorkbook :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If LCase(Sh.Name) <> "matrice" Then Exit Sub
Dim col%
Application.ScreenUpdating = False
On Error Resume Next
For col = 2 To Sh.Cells(2, Sh.Columns.Count).End(xlToLeft).Column
    If IsError(Sheets(CStr(Sh.Cells(2, col)))) Then
        With Sh.Cells(3, col).Resize(50)
            .ClearContents
            .Interior.ColorIndex = xlNone
        End With
    End If
Next
End Sub

 

[chaelie2015]

Re
Après avoir intégré ce code dans mon fichier principal et l'avoir exécuté, une erreur d'exécution '1004' ( a ce niveau du code .Cells(1, n).Copy c(1 + n) )s'est produite. Le message d'erreur indique : "La cellule ou le graphique que vous essayez de modifier se trouve sur une feuille protégée. Pour y apporter des modifications, cliquez sur "Ôter la protection de la feuille" sous l'onglet Révision." Pourriez-vous m'expliquer d'où provient ce message exactement ?
MERCI

 

[job75]

Le message est facile à comprendre quand on parle le français.

 

[chaelie2015]

Le message est facile à comprendre quand on parle le français.

Re
hhhhhhh, vous avez raison, j'ai ôté la protection de la feuille 'Matrice'.