Private Sub Auto_Open()
    Dim cmdBar As CommandBar
    Dim cmdButton As CommandBarButton
    Dim cmdBarName As String
    Dim b As Boolean
 
    b = False
    cmdBarName = "RangeCopy"
 
    For Each cmdBar In Application.CommandBars
       If cmdBar.Name = cmdBarName Then b = True: Exit For
    Next
 
    If Not b Then
        Set cmdBar = Application.CommandBars.Add(Name:=cmdBarName, _
          Temporary:=True)
        cmdBar.Visible = True
        Set cmdButton = cmdBar.Controls.Add(msoControlButton)
        With cmdButton
           .Style = msoButtonIconAndCaption
           .BuiltInFace = True
           .Caption = "Tabellen kopieren"
           .FaceId = 45 'eventuell anderes Ikon
           .OnAction = "SearchTabelle"
           .TooltipText = "Suchen in Range A5 und kopieren"
           .Visible = True
        End With
    End If
End Sub
 
Private Sub SearchTabelle()
   Dim sh As Object
   Dim n As Long
 
   n = 1
   For Each sh In ActiveWorkbook.Sheets
      If sh.Name <> "Seite9" Then
          sh.Select
          If ActiveSheet.Range("A5").Value > 0 And _
                  ActiveSheet.Range("A5").Value <> 10 Then
              ActiveSheet.Range("A5:B5").Select
              Selection.Copy
              ActiveWorkbook.Sheets("Seite9").Select
              ActiveSheet.Cells(n, 1).Select
              Selection.PasteSpecial Paste:=xlValues
              n = n + 1
          End If
      Else
          Exit For
      End If
   Next
End Sub