Declarer nom de feuille

bonjour a tous

voici mon code actuel :

Sub Gestion_kiwa_1() 'outil necessaire
'analyse des reference de prog et ajoute les numero d'outils necessaire'
Dim i As Byte, col As Byte
Dim cel As Range
Dim derlig As Integer, nblig As Integer
Dim chemin As String, fichier  As String

Range("r10:w83").Select
    Selection.ClearContents

chemin = "M:\MAG OUTIL\AA  27-03-02\PALETISE\"
fichier = "1 ok cas emplois outils paletises.xlsm"

Workbooks.Open chemin & fichier

With Workbooks(fichier).Sheets("BASE GLOBAL")

    For Each cel In .ListObjects("Tableau27").ListColumns(1).DataBodyRange
        On Error Resume Next
        With ThisWorkbook.Sheets("KIWA 1")
        col = .Range("r9:w9").Find(cel.Value, LookIn:=xlValues, lookat:=xlWhole).Column
        If col > 0 Then
            derlig = .Cells(Rows.Count, col).End(xlUp).Row + 1
            .Cells(derlig, col) = cel.Offset(0, 7).Value
        End If
        col = 0
        End With
    Next cel
End With

ActiveWorkbook.Close SaveChanges:=False
Range("P20").Select

End Sub

j'aimerai a ne pas avoir a indiqué le nom de la feuille nommé "KIWA 1" mais simplement une variable qui recupere le nom de la feuille active .

j'ai de nombreuses feuilles nommer différemment forcement et du coup je doit avoir un code pour chacunes d'elles...

merci d'avance de votre aide.

bonjour,

essaie ceci (non testé)

Sub Gestion() 'outil necessaire
    'analyse des reference de prog et ajoute les numero d'outils necessaire'
    Dim i As Byte, col As Byte
    Dim cel As Range
    Dim derlig As Integer, nblig As Integer
    Dim chemin As String, fichier  As String, ash As Worksheet

    Set ash = ActiveSheet
    ash.Range("r10:w83").ClearContents

    chemin = "M:\MAG OUTIL\AA  27-03-02\PALETISE\"
    fichier = "1 ok cas emplois outils paletises.xlsm"

    Workbooks.Open chemin & fichier

    With Workbooks(fichier).Sheets("BASE GLOBAL")

        For Each cel In .ListObjects("Tableau27").ListColumns(1).DataBodyRange
            On Error Resume Next
            With ash
                col = .Range("r9:w9").Find(cel.Value, LookIn:=xlValues, lookat:=xlWhole).Column
                If col > 0 Then
                    derlig = .Cells(Rows.Count, col).End(xlUp).Row + 1
                    .Cells(derlig, col) = cel.Offset(0, 7).Value
                End If
                col = 0
            End With
        Next cel
    End With

    ActiveWorkbook.Close SaveChanges:=False
    ash.Range("P20").Select

End Sub

Bonjour Slygan, h2so4

Perso, voilà ce que je ferais

Sub Gestion_kiwa_1() 'outil necessaire
  'analyse des reference de prog et ajoute les numero d'outils necessaire'
  Dim Col As Long, Cel As Range
  Dim DerLig As Long, NbLig As Long
  Dim Chemin As String, Fichier  As String
  Dim WbkS As Workbook, ShtS As Worksheet

  Chemin = "M:\MAG OUTIL\AA  27-03-02\PALETISE\"
  Fichier = "1 ok cas emplois outils paletises.xlsm"

  ActiveSheet.Range("r10:w83").ClearContents

  Set WbkS = Workbooks.Open(Chemin & Fichier)
  Set ShtS = WbkS.Sheets("BASE GLOBAL")
  For Each Cel In ShtS.ListObjects("Tableau27").ListColumns(1).DataBodyRange
      On Error Resume Next
      With ThisWorkbook.ActiveSheet
      Col = .Range("r9:w9").Find(Cel.Value, LookIn:=xlValues, lookat:=xlWhole).Column
      If Col > 0 Then
          DerLig = .Cells(Rows.Count, Col).End(xlUp).Row + 1
          .Cells(DerLig, Col) = Cel.Offset(0, 7).Value
      End If
      Col = 0
      End With
  Next Cel
  WbkS.Close SaveChanges:=False
  ActiveSheet.Range("P20").Select
End Sub

A+

merci a vous deux !!!

je conserve la proposition de BrunoM45 ; elle est pour moi plus compréhensible.