помогите пожалуйста с макросом

[cargoline9]

здравствуйте!
помогите пожалуйста… очень нужен макрос, который перенесет копии листов из книги в три разные новые книги, причём без формул, а в виде значений и уберёт лишние строки в новых книгах.

в файле описал задачу немного конкретнее

очень надеюсь на вашу помощь!

[Teslenko_EA]

Здравствуйте cargoline9.
Вашу задачу может выполнить подобный код:

Sub repl()
Dim oB As Workbook, oB1 As Workbook, oB2 As Workbook, oB3 As Workbook, oBm As Workbook, oS As Object
Set oB = ActiveWorkbook: Set oB1 = Workbooks.Add: Set oB2 = Workbooks.Add: Set oB3 = Workbooks.Add
Application.ScreenUpdating = False
For Each oS In oB.Sheets
    Set oBm = Nothing
    Select Case oS.Name
    Case "11", "22", "33", "44", "aa", "ss", "dd": Set oBm = oB1
    Case "qq", "ww": Set oBm = oB2
    Case "zzz", "xxx", "ccc", "vvv", "bbb", "nnn": Set oBm = oB3
    End Select
    If Not oBm Is Nothing Then
        oS.Copy BEFORE:=oBm.Sheets(1)
        With oBm.Sheets(oS.Name)
            .Cells.Copy
            .Cells.PasteSpecial Paste:=xlPasteValues
            For J = .Cells(Rows.Count, 2).End(xlUp).Row To 1 Step -1
                If .Cells(J, 1) = 1 Then .Rows(J).Delete Shift:=xlUp
            Next
        End With
    End If
Next
End Sub

Евгений.

[cargoline9]

Здравствуйте Евгений.
Большое спасибо за помощь! Всё работает!!!