ниже приведен код который по условию нарезает и сохраняет в файлы из большой таблицы. Как можно сделать чтоб заголовок состоял из 2х строк ?? В этом примере он состоит из 1 ой - тоесть нужно что б 1и 2я строка во всех файла повторялись исходной таблиицы
Sub Íàðåçàòü() 'óíèâåðñàëüíûé âàðèàíò Dim r As Range, rng As Range, x, i&, c&, k$, colC As New Collection
On Error Resume Next Set r = Application.InputBox("Ùåëêíèòå ÿ÷åéêó âíóòðè òàáëèöû", "Âûáîð ñòîëáöà", _ ActiveCell.Address, Type:= [Здорово] If r Is Nothing Then Exit Sub Set rng = r.CurrentRegion: x = rng.Value: c = r.Column - rng.Column + 1 If MsgBox("Âûáèðàåì äàííûå èç ñòîëáöà " & rng(1, c), vbYesNo, _ "Âûáîð ñòîëáöà" [Шутливо] = vbNo Then Exit Sub Application.ScreenUpdating = False If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
For i = 3 To UBound(x) k = CStr(x(i, c)) If IsEmpty(colC.Item(k)) Then colC.Add k, k rng.AutoFilter Field:=c, Criteria1:=k, Operator:=xlOr, Criteria2:="=" ActiveSheet.UsedRange.SpecialCells(12).Copy With Workbooks.Add With .Sheets(1) .Paste: .Shapes(1).Delete End With .SaveAs Filename:=ThisWorkbook.Path & "\" & k & ".xlsx", _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False .Close End With End If Next i: rng.AutoFilter Application.ScreenUpdating = True End Sub
ниже приведен код который по условию нарезает и сохраняет в файлы из большой таблицы. Как можно сделать чтоб заголовок состоял из 2х строк ?? В этом примере он состоит из 1 ой - тоесть нужно что б 1и 2я строка во всех файла повторялись исходной таблиицы
Sub Íàðåçàòü() 'óíèâåðñàëüíûé âàðèàíò Dim r As Range, rng As Range, x, i&, c&, k$, colC As New Collection
On Error Resume Next Set r = Application.InputBox("Ùåëêíèòå ÿ÷åéêó âíóòðè òàáëèöû", "Âûáîð ñòîëáöà", _ ActiveCell.Address, Type:= [Здорово] If r Is Nothing Then Exit Sub Set rng = r.CurrentRegion: x = rng.Value: c = r.Column - rng.Column + 1 If MsgBox("Âûáèðàåì äàííûå èç ñòîëáöà " & rng(1, c), vbYesNo, _ "Âûáîð ñòîëáöà" [Шутливо] = vbNo Then Exit Sub Application.ScreenUpdating = False If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
For i = 3 To UBound(x) k = CStr(x(i, c)) If IsEmpty(colC.Item(k)) Then colC.Add k, k rng.AutoFilter Field:=c, Criteria1:=k, Operator:=xlOr, Criteria2:="=" ActiveSheet.UsedRange.SpecialCells(12).Copy With Workbooks.Add With .Sheets(1) .Paste: .Shapes(1).Delete End With .SaveAs Filename:=ThisWorkbook.Path & "\" & k & ".xlsx", _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False .Close End With End If Next i: rng.AutoFilter Application.ScreenUpdating = True End SubRomzes
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
