копирование выделенного диапазона после скрытия ненужных столбцов и последующей фильтрации

[Алабор]

Доброго времени суток.
Есть такая задача: материалы из перечня должны быть перенесены на отдельные листы(в последствии файлы) в соответствии с наименованием предприятия (строка 1).
При форматировании и переносе данных макрос работает, пока не включаю строку со скрытием столбцов "d:g". После этого копирование отфильтрованных данных не срабатывает.Подскажите где ошибка?
И второй вопрос: как написать, что б на новый лист переносились только столбцы этого конкретного предприятия? (т.е ПЧ-15_к и ПЧ-15_с, к примеру)
За ранее благодарен

[Алабор]

ошибка вылетает вот тут:

Sub Макрос2()
sh = LTrim(Worksheets(1).Cells(3, 6)) 'путь к листу
Col = LTrim(Worksheets(1).Cells(4, 6)) 'путь к столбцу
Sheets(sh).Select
Selection.AutoFilter Field:=Col, Criteria1:="<>"
'убираем проверочные столбцы
Columns("D:G").EntireColumn.Hidden = True ' второй вариан скрытия
'фильтруем "непустые" в выбранном предприятии
Set sh = ActiveSheet
' выделяем нужный диапазон
Set mr = sh.AutoFilter.Range.Offset(1, 0). _
Resize(sh.AutoFilter.Range.Rows.Cou nt - 1, sh.AutoFilter.Range.Columns.Count)
mr.SpecialCells(xlCellTypeVisible). EntireRow.Select
Selection.Copy

[Алабор]

ну, может кому пригодится:

Sub Макрос6()
sh = LTrim(Worksheets(1).Cells(3, 6).Text) 'путь к листу
Col_ = Worksheets(1).Cells(4, 6).Value 'путь к столбцу

Sheets(sh).Select

For i = 4 To Col_ - 1
Columns(i).Select
Selection.EntireColumn.Hidden = True ' второй вариан скрытия
Next

Selection.AutoFilter Field:=Col_, Criteria1:="<>"
Set sh = ActiveSheet ' из за этого не выделялся лист по переменной. Теперь SH - это лист а не его название
' выделяем нужный диапазон

nR = sh.AutoFilter.Range.Rows.Count
Range(Cells(3, 1), Cells(nR, Col_ + 1)).Select
Selection.Copy ' копируем выделенное
Sheets.Add.Name = "Предприятие" ' добавляем новый лист с названием предприятия
Sheets("Предприятие").Select ' выбираем этот лист
Range("A2").Select ' ячейка начала вставки
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' вставка только значений без формул
With Selection ' начало форматирования
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.EntireColumn.AutoFit
End With ' конец форматирования
'Создание "шапки"
Range("A1").Select
ActiveCell.FormulaR1C1 = "Код СК-МТР"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Наименование"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Е.И."
Range("D1").Select
ActiveCell.FormulaR1C1 = "Кол-во"
Columns(4).Select
Selection.NumberFormat = "#,##0.00"
Columns(5).Select
Selection.NumberFormat = "#,##0.00"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Сумма"

ActiveWorkbook.Save ' сохраняем лист
sh.Activate
'Worksheets(sh.Name).Activate
Selection.AutoFilter Field:=Col_
For i = 4 To Col_ - 1
Columns(i).Select
Selection.EntireColumn.Hidden = False
Next
Sheets("кнопочка").Select

End Sub

Теперь все работает