Обсуждение и советы: создание интернет-магазинов - решения, процессы, прайсинг

Код: Выделить всё

Option Explicit

Sub MainVBA()

Dim Категория As String
Dim Производитель As String
Dim i As Long

For i = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(i, 1) <> "" And Trim(Cells(i, 2)) = "" Then
    Категория = Cells(i, 1)
Else
    Cells(i, 5) = Категория
    If Cells(i, 1) <> "" And Trim(Cells(i, 2)) <> "" And Cells(i, 1).Interior.ColorIndex = 35 Then
        Производитель = Cells(i, 1)
        Cells(i, 6) = Производитель
        Cells(i, 7) = Cells(i, 6) & " " & Cells(i, 2)
    Else
        Cells(i, 6) = Производитель
        Cells(i, 7) = Cells(i, 6) & " " & Cells(i, 2)
    End If
End If
Next i

Dim varNewFileName As String
Dim fs As Object
Dim nSourceFile As Long

Set fs = CreateObject("Scripting.FileSystemObject")
varNewFileName = Replace(ActiveWorkbook.FullName, ActiveWorkbook.Name, "") & "_" & ActiveWorkbook.Name
If fs.FileExists(varNewFileName) = True Then
    Kill varNewFileName
End If

Application.DisplayAlerts = False
nSourceFile = Workbooks.Count
ChDir ActiveWorkbook.Path
ActiveWorkbook.SaveAs Filename:=varNewFileName, FileFormat:=ActiveWorkbook.FileFormat
Workbooks.Item(nSourceFile).Close
'Application.Quit
End Sub