LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1             
Worksheets("Лист1").Range("C" & LastRow) = Format(Now, "General Date")
Worksheets("Лист1").Range("D" & LastRow) = Format(Now + 1, "General Date")

Worksheets("Лист1").Range("D2") = Right(Worksheets("Лист1").Range("D2"), Len(Worksheets("Лист1").Range("D2")) - 1)

Replace What:="'", Replacement:=""  
Replace What:="~'", Replacement:=""

Private Sub TableHtml()
    ' макрос для экспорта выделенного диапазона ячеек в HTML
    On Error Resume Next
'    'Прячем ненужные ячейки если необходимо
'    Range("G:H").EntireColumn.Hidden = True




'На случай выделения несвязанных диапазонов
Selection.Areas(1).Select

'Обозначаем строки и колонки
    iFirstLine = Selection.Row
    iFirstCol = Selection.Column
    iLastLine = iFirstLine + Selection.Rows.Count - 1
    iLastCol = iFirstCol + Selection.Columns.Count - 1



    'HTML классы для таблицы и четного ряда данных
    sTableClass = "ExcelTable"
    sOddRowClass = "odd"

    sOutput = "<div><table class='" & sTableClass & "' border=1 width=100% align=center>"    ' Начинаем таблицу
    'sOutput = sOutput & "<caption>" & Cells(iFirstLine, iFirstCol).Text & "</caption>"

    For k = iFirstLine To iLastLine    ' Обрабатываем Excel таблицу
        If (k \ 2 <> k / 2) Then    'проверяем на четность
            sLine = "<tr class ='" & sOddRowClass & "'>"
        Else
            sLine = "<tr>"
        End If

        iCountColspan = 0    'счетчик объединенных ячеек
        For j = iFirstCol To iLastCol
            'Проверяем, не объединена ли эта ячейка с соседними.
            If Cells(k, j).MergeCells = True Then
                'Получаем число объединенных ячеек
                iCountColspan = Cells(k, j).MergeArea.Count
            Else
                iCountColspan = 0
            End If
            Set oCurrentCell = ActiveSheet.Cells(k, j)
            sLine = sLine & "<td"

            'Проверяем, нужно ли вставлять код объединения ячейки с соседними
            If iCountColspan > 1 Then
                sLine = sLine & " colspan=" & iCountColspan
                j = j + iCountColspan - 1    'пропускаем ячейки
                iCountColspan = 0
            End If

            'Если по центру
            If oCurrentCell.HorizontalAlignment = -4108 Then sLine = sLine & " style='text-align: center;'"
            sLine = sLine & ">"

            'Если пусто, прописываем  
            If oCurrentCell.Text <> "" Then sValue = oCurrentCell.Text Else sValue = " "
            
            'Если жирный
            If oCurrentCell.Font.Bold = True Then sValue = "<b>" & sValue & "</b>"
            
            'Если курсив
            If oCurrentCell.Font.Italic = True Then sValue = "<i>" & sValue & "</i>"

            sLine = sLine & sValue & "</td>"
            If k = iFirstLine Then sLine = Replace(sLine, "<td", "<th")

        Next j
        sOutput = sOutput & sLine & "</tr>"
    Next k

    sOutput = sOutput & "</table></div> <style>& ""table{width: 100%; border-collapse: collapse;}td{border: 1px solid;border-collapse:collapse;}</style>"  'Заканчиваем таблицу

'Удаляем прошлую версию файла
 Kill "G:\Лист1.html"

'записываем результат в файл .txt
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim Fileout As Object
    Set Fileout = fso.CreateTextFile("G:\Лист1.txt", True, True)
    Fileout.Write (sOutput)
    Fileout.Close

'Из файла .txt делаем .html
Name "G:\Лист1.txt" As "G:\Лист1.html"



'Открываем хтмльку, если необходимо
CreateObject("wscript.shell").Run "explorer.exe /e,/open,""" & "G:\Лист1.html"

End Sub

Private Sub CommandButton1_Click()
    ' макрос для экспорта выделенного диапазона ячеек в HTML
    On Error Resume Next


    Selection.Areas(1).Select    ' на случай выделения несвязанных диапазонов

    iFirstLine = Selection.Row
    iFirstCol = Selection.Column
    iLastLine = iFirstLine + Selection.Rows.Count - 1
    iLastCol = iFirstCol + Selection.Columns.Count - 1


    'HTML классы для таблицы и четного ряда данных
    sTableClass = "ExcelTable"
    sOddRowClass = "odd"

    sOutput = "<div><table class='" & sTableClass & "' border=1 width=100% align=center>"    ' Начинаем таблицу
    'sOutput = sOutput & "<caption>" & Cells(iFirstLine, iFirstCol).Text & "</caption>"

    For k = iFirstLine To iLastLine    ' Обрабатываем Excel таблицу
        If (k \ 2 <> k / 2) Then    'проверяем на четность
            sLine = "<tr class ='" & sOddRowClass & "'>"
        Else
            sLine = "<tr>"
        End If

        iCountColspan = 0    'счетчик объединенных ячеек
        For j = iFirstCol To iLastCol
            'Проверяем, не объединена ли эта ячейка с соседними.
            If Cells(k, j).MergeCells = True Then
                'Получаем число объединенных ячеек
                iCountColspan = Cells(k, j).MergeArea.Count
            Else
                iCountColspan = 0
            End If
            Set oCurrentCell = ActiveSheet.Cells(k, j)
            sLine = sLine & "<td"

            'Проверяем, нужно ли вставлять код объединения ячейки с соседними
            If iCountColspan > 1 Then
                sLine = sLine & " colspan=" & iCountColspan
                j = j + iCountColspan - 1    'пропускаем ячейки
                iCountColspan = 0
            End If

            'Если по центру
            If oCurrentCell.HorizontalAlignment = -4108 Then sLine = sLine & " style='text-align: center;'"
            sLine = sLine & ">"

            'Если пусто, прописываем  
            If oCurrentCell.Text <> "" Then sValue = oCurrentCell.Text Else sValue = " "
            'Если жирный
            If oCurrentCell.Font.Bold = True Then sValue = "<b>" & sValue & "</b>"
            'Если курсив
            If oCurrentCell.Font.Italic = True Then sValue = "<i>" & sValue & "</i>"

            sLine = sLine & sValue & "</td>"
            If k = iFirstLine Then sLine = Replace(sLine, "<td", "<th")

        Next j
        sOutput = sOutput & sLine & "</tr>"
    Next k

   'Заканчиваем таблицу
    sOutput = sOutput & "</table></div> <style>& ""table{width: 100%; border-collapse: collapse;}td{border: 1px solid;border-collapse:collapse;}</style>"  

    ' Копируем полученный HTML в буфер обмена
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText sOutput: .PutInClipboard
    End With

  'записываем результат в файл .txt
  clipboard = CreateObject("HTMLFile").parentWindow.clipboardData.GetData("text")
'удаляем прошлую версию файла

Kill "G:Лист1.html"

file = "G:\Лист1.txt"
 '8 - дозапись, True - создавать, если
Set ofile = CreateObject("Scripting.FileSystemObject").OpenTextFile(file, 8, True)
'Вписываем из буфера обмена
ofile.WriteLine (clipboard)
ofile.Close

WScript.Echo "OK"

'Из файла .txt делаем .html

Name "G:\Лист1.txt" As "G:\Лист1.html"