Extraction infos des feuilles sauf ...

[yoyo69]

Bonjour,

Dans le code ci-dessous, je recupere les valeurs dans la feuille [Synthes], les cellules B6, B11, M43, B24, D32 des feuilles du classeur. Mais je veux exclure les feuilles [Synthes] et [-DEVIS-]
Je voudrais meme de preference selectionner les infos uniquement dans les feuilles [POSTE**] soit POSTE 1, POSTE 2, etc ...

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim i%
If Not ActiveSheet.Name = "-DEVIS-" Then Exit Sub
With Sheets("Synthes")
.Range("A2:E65536").ClearContents
For i = 1 To Sheets.Count
If Not Sheets(i).Name = "Synthes" Or Not Sheets(i).Name = "-DEVIS-" Then
.Cells(.Range("A65536").End(xlUp).Row + 1, 1).Value = Sheets(i).Range("B6").Value
.Cells(.Range("B65536").End(xlUp).Row + 1, 2).Value = Sheets(i).Range("B11").Value
.Cells(.Range("C65536").End(xlUp).Row + 1, 3).Value = Sheets(i).Range("M39").Value
.Cells(.Range("D65536").End(xlUp).Row + 1, 4).Value = Sheets(i).Range("B24").Value
.Cells(.Range("E65536").End(xlUp).Row + 1, 5).Value = Sheets(i).Range("D28").Value
End If
Next i
End With
End Sub

Comment corriger ce code, merci
Cordialement, Yoyo

 

[Cousinhub]

Re : Extraction infos des feuilles sauf ...

Bonjour, tu insères ce code dans le code de la feuille "DEVIS" :

Private Sub Worksheet_Activate()
Dim i%
With Sheets("Synthes")
.Range("A2:E65536").ClearContents
For i = 1 To Sheets.Count
If Sheets(i).Name Like "Poste*" Then
.Cells(.Range("A65536").End(xlUp).Row + 1, 1).Value = Sheets(i).Range("B6").Value
.Cells(.Range("B65536").End(xlUp).Row + 1, 2).Value = Sheets(i).Range("B11").Value
.Cells(.Range("C65536").End(xlUp).Row + 1, 3).Value = Sheets(i).Range("M39").Value
.Cells(.Range("D65536").End(xlUp).Row + 1, 4).Value = Sheets(i).Range("B24").Value
.Cells(.Range("E65536").End(xlUp).Row + 1, 5).Value = Sheets(i).Range("D28").Value
End If
Next i
End With
End Sub

Bon courage

PS le nom de l'onglet est POSTE et non Poste (sensible à la casse)

 

[yoyo69]

Re : Extraction infos des feuilles sauf ...

merci bhbh, c'est ok
Bonne journée

Cordialement, Yoyo