Function ПолучитьЛист(ИмяЛиста) As Worksheet
    Dim tmpWSh As Worksheet
    On Error Resume Next
    Set tmpWSh = ActiveWorkbook.Sheets(ИмяЛиста)
    If Err.Number <>  0  Then
        Set tmpWSh = ActiveWorkbook.Sheets.Add
        tmpWSh.Name = ИмяЛиста
    Else
        tmpWSh.UsedRange.Clear
    End If
    On Error GoTo  0 
    Set ПолучитьЛист = tmpWSh
End Function
 
Function ЭтоМесяц(ТекстЗнач) As Boolean
    Dim AllMonth As String
    ЭтоМесяц = False
    ТекстЗнач = LCase(ТекстЗнач)
    If InStr( 1 , "янв.08,фев.08,мар.08,апр.08,май.08,июн.08,июл.08,авг.08,сен.08,окт.08,ноя.08,дек.08", ТекстЗнач) >  0  Then
        ЭтоМесяц = True
    End If
End Function
 
Function ПолучитьНомерМесяца(ТекстЗнач) As Integer
    Dim StartPos As Integer
    Dim i As Integer
    Dim MonthNumber As Integer
    MonthNumber =  0 
    StartPos = InStr( 1 , "янв.08,фев.08,мар.08,апр.08,май.08,июн.08,июл.08,авг.08,сен.08,окт.08,ноя.08,дек.08", ТекстЗнач)
    For i =  1  To StartPos
        If Mid$("янв.08,фев.08,мар.08,апр.08,май.08,июн.08,июл.08,авг.08,сен.08,окт.08,ноя.08,дек.08", i,  1 ) = "," Then
            MonthNumber = MonthNumber +  1 
        End If
    Next i
    ПолучитьНомерМесяца = MonthNumber +  1 
End Function
 
Sub Sunnych_current_txt()
' Саныч Макрос
' Макрос записан 5.02.2008 (Sunnych)
    Dim SH As Worksheet
    Dim iCol As Integer
    Dim iStartCol As Integer
    Dim iMaxCol As Integer
    Dim iRow As Integer
    Dim iMaxRow As Integer
    Dim vVar1 As Variant
    Dim strT1 As String
    Dim intOffset As Integer
     
    Set SH = ПолучитьЛист("Лист3")
    iStartCol =  0 
    iMaxCol = Sheets("Лист1").UsedRange.Columns.Count + Sheets("Лист1").UsedRange.Column -  1 
    For iCol =  3  To iMaxCol
        Debug.Print Sheets("Лист1").UsedRange.Columns(iCol).Width
        If (Sheets("Лист1").UsedRange.Columns(iCol).Width >  1 ) And (iStartCol =  0 ) Then
            iStartCol = iCol
            Exit For
        End If
    Next iCol
    intOffset = iStartCol - ПолучитьНомерМесяца(LCase(Trim$(Sheets("Лист1").Cells( 8 , iStartCol).Text)))
    For iCol = iStartCol To iMaxCol
        Debug.Print Sheets("Лист1").UsedRange.Columns(iCol).Width
        If Sheets("Лист1").UsedRange.Columns(iCol).Width >  3  Then
            strT1 = Trim$(Sheets("Лист1").Cells( 8 , iCol).Text)
            If ЭтоМесяц(strT1) = False Then
                Exit For
            End If
            SH.Cells( 1 , ПолучитьНомерМесяца(strT1)).FormulaR1C1 = strT1
            SH.Cells( 1 , ПолучитьНомерМесяца(strT1)).NumberFormat = "[$-419]mmmm yyyy"
        End If
    Next iCol
    iMaxCol = iCol -  1      
    iRow =  9 
    Do While Trim$(Sheets("Лист1").Cells(iRow,  1 ).Text) <> ""
        For iCol = iStartCol To iMaxCol
            strT1 = Trim$(Sheets("Лист1").Cells(iRow, iCol).Text)
            If sText = "" Then
                sText = "0"
            ElseIf sText = "резерв" Then
                sText = "0R"
            ElseIf sText = "с 15" Then
                sText = "занят с 15"
            ElseIf sText = "до 15" Then
                sText = "занят до 15"
            Else
                sText = "1"
            End If
            SH.Cells(iRow -  7 , iCol - intOffset).NumberFormat = ""         
        Next iCol
        iRow = iRow +  1          
    Loop     
    For iCol =  1  To SH.UsedRange.Columns.Count
        If SH.Cells( 1 , iCol).Text <> "" Then
            iStartCol = iCol
            Exit For
        End If
    Next iCol
    SH.Activate
    For iCol =  1  To iStartCol -  1 
        SH.Range(Cells( 2 , iStartCol), Cells(SH.UsedRange.Rows.Count, iStartCol)).Select
        Selection.Copy
        SH.Cells( 2 , iCol).Select
        SH.Paste
    Next iCol     
    SH.Select
    For iCol = SH.UsedRange.Columns.Count +  1  To  12 
        SH.Range(Cells( 2 , SH.UsedRange.Columns.Count), Cells(SH.UsedRange.Rows.Count, SH.UsedRange.Columns.Count)).Select
        Selection.Copy
        SH.Cells( 2 , iCol).Select
        SH.Paste
    Next iCol    
    SH.Activate
    SH.Range(SH.Cells( 1 ,  1 ), SH.Cells(SH.UsedRange.Rows.Count, SH.UsedRange.Columns.Count)).Select
    Selection.Copy
 
End Sub

        If Sheets("Лист1").UsedRange.Columns(iCol).Width >  3  Then
        If IsDate(Sheets("Лист1").Cells( 8 , iCol).Value) Then
            MonthNumber = Month(Sheets("Лист1").Cells( 8 , iCol).Value)