Sub НазваниеЛистаНаЛист()

    Dim sh As Worksheet

    For Each sh In ActiveWorkbook.Worksheets

        JobSheet sh

    Next

End Sub

Sub JobSheet(sh As Worksheet)

    With sh

        Dim yy As Long

        yy = .Cells(.Rows.Count, 1).End(xlUp).Row

        If yy >
4 Then

            .Range(.Cells(5, 3), .Cells(yy, 4)).Value
= Array(.Range("B3").Value, .Name)

            .Rows("1:4").Delete Shift:=xlUp

        End If

    End With

End Sub

Sub Redesigner()
    Dim inpdata As Range, realdata As Range, ns As Worksheet
    Dim i&, j&, k&, c&, r&, hc&, hr&
    Dim out() As String, dataArr, hcArr, hrArr
    
    For Each ws In Worksheets
  With ws
     Set inpdata = ThisWorkbook.Application.InputBox( _
   prompt:="¬ыберите обрабатываемый диапазон:", Title:="¬ыбор диапазона", Type:=8)
    
   hr = Val(InputBox("—колько строк с подпис€ми сверху?"))
   hc = Val(InputBox("—колько столбцов с подпис€ми слева?"))

   
    If inpdata.Rows.Count <= hr Or inpdata.Columns.Count <= hc Then Exit Sub
    Set realdata = inpdata.Offset(hr, hc).Resize(inpdata.Rows.Count - hr, inpdata.Columns.Count - hc)
    dataArr = realdata.Value
    If hr Then hrArr = inpdata.Offset(0, hc).Resize(hr, inpdata.Columns.Count - hc).Value
    If hc Then hcArr = inpdata.Offset(hr, 0).Resize(inpdata.Rows.Count - hr, hc).Value
    
    ReDim out(1 To Application.CountA(realdata), 1 To hr + hc + 1)
    Set ns = Worksheets.Add
    
    For i = 1 To UBound(dataArr, 1)
        For j = 1 To UBound(dataArr, 2)
            If Not IsEmpty(dataArr(i, j)) Then
                k = k + 1
                For c = 1 To hc: out(k, c) = hcArr(i, c): Next c
                For r = 1 To hr: out(k, c + r - 1) = hrArr(r, j): Next r
                out(k, c + r - 1) = dataArr(i, j)
            End If
    Next j, i
    ns.Cells(2, 1).Resize(UBound(out, 1), UBound(out, 2)) = out
    End with ws
    Next ws
End Sub

for I=1 to sheets.count
if worksheets(i).name<> ""then

end if
next I

Sub Redesigner()    
Dim inpdata As Range, realdata As Range, ns As Worksheet    
Dim i&, j&, k&, c&, r&, hc&, hr&    
Dim out(), dataArr, hcArr, hrArr        
Set inpdata = ThisWorkbook.Application.InputBox( _   prompt:="Выберите обрабатываемый диапазон:", Title:="Выбор диапазона", Type:=8)       
hr = Val(InputBox("Сколько строк с подписями сверху?"))   
hc = Val(InputBox("Сколько столбцов с подписями слева?"))       
If inpdata.Rows.Count <= hr Or inpdata.Columns.Count <= hc Then Exit Sub    
Set realdata = inpdata.Offset(hr, hc).Resize(inpdata.Rows.Count - hr, inpdata.Columns.Count - hc)    
dataArr = realdata.Value    If hr Then hrArr = inpdata.Offset(0, hc).Resize(hr, inpdata.Columns.Count - hc).Value    
If hc Then hcArr = inpdata.Offset(hr, 0).Resize(inpdata.Rows.Count - hr, hc).Value        
ReDim out(1 To Application.CountA(realdata), 1 To hr + hc + 1)    
Set ns = Worksheets.Add        
For i = 1 To UBound(dataArr, 1)        
For j = 1 To UBound(dataArr, 2)            
If Not IsEmpty(dataArr(i, j)) Then                
k = k + 1                
For c = 1 To hc: out(k, c) = hcArr(i, c): Next c                
For r = 1 To hr: out(k, c + r - 1) = hrArr(r, j): Next r                
out(k, c + r - 1) = dataArr(i, j)            
End If    Next j, I    
ns.Cells(2, 1).Resize(UBound(out, 1), 
UBound(out, 2)) = out
End Sub

Sub CollectDataFromAllSheets()    
Dim ws As Worksheet       
 Set wbCurrent = ActiveWorkbook   
 Workbooks.Add    
Set wbReport = ActiveWorkbook    
  wbCurrent.Worksheets(1).Range("A1:D1").Copy Destination:=wbReport.Worksheets(1).Range("A1")       
 For Each ws In wbCurrent.Worksheets          
 n = wbReport.Worksheets(1).Range("A1").CurrentRegion.Rows.Count                
     Set rngData = ws.Range("A1:D5")            
     Set rngData = ws.UsedRange                    
Set rngData = ws.Range("F5").CurrentRegion    
    Set rngData = ws.Range("A1", ws.Range("A1").SpecialCells(xlCellTypeLastCell))    
    rngData.Copy Destination:=wbReport.Worksheets(1).Cells(n + 1, 1)          
  Next ws
End Sub

import pandas as pd
import xlrd as xl

lnk = ""

def read_doc(source):
    res_d = list()

    sheets = pd.ExcelFile(source) .sheet_names
    for i in sheets:
        frame = pd.read_excel(source, sheet_name=i)
        frame['D'] = frame.values[0][0]
        frame['E'] = frame.values[1][0]
        res_d.append(frame[4:])
    res = pd.concat(res_d)
    res.to_excel('out.xls', index=False)

    return True

get_label(lnk)