Пикабушники, доброй ночи.
Помогите, пожалуйста, с макросом, гугл молчит((
Есть общий файл с организациями и их сотрудниками, то есть несколько подряд одинаковых ИНН, но разные сотрудники, нужно
-копировать все строки одной организации в новую книгу (файл), включая шапку;
-сохранить и закрыть файл.
Название новой книги должно быть вида «ИНН Название компании». Файлы https://yadi.sk/d/ZWZ5I4TP87rLkA Заранее спасибо.
786 постов15K подписчика
1. Не нарушать правила Пикабу
2. Публиковать посты соответствующие тематике сообщества
3. Проявлять уважение к пользователям
4. Не допускается публикация постов с вопросами, ответы на которые легко найти с помощью любого поискового сайта.
По интересующим вопросам можно обратиться к автору поста схожей тематики, либо к пользователям в комментариях
Важно - сообщество призвано помочь, а не постебаться над постами авторов! Помните, не все обладают 100 процентными знаниями и навыками работы с Office. Хотя вы и можете написать, что вы знали об описываемом приёме раньше, пост неинтересный и т.п. и т.д., просьба воздержаться от подобных комментариев, вместо этого предложите способ лучше, либо дополните его своей полезной информацией и вам будут благодарны пользователи.
Утверждения вроде "пост - отстой", это оскорбление автора и будет наказываться баном.
Application.ScreenUpdating = False
Set shMain = Sheets("32")
lr = shMain.Cells(Rows.Count, "C").End(xlUp).Row
For i = 2 To lr
If shMain.Range("C" & i) <> shMain.Range("C" & i - 1) Then
k = 1
Set wb = Workbooks.Add(1): Set sh = wb.Sheets(1)
shMain.Rows(1).Copy
sh.Range("A1").PasteSpecial xlPasteAll
wb.SaveAs ThisWorkbook.Path & "\" & shMain.Range("C" & i) & " .xlsx", FileFormat:=xlOpenXMLWorkbook
k = k + 1
sh.Rows(k) = shMain.Rows(i).Value
If shMain.Range("C" & i) <> shMain.Range("C" & i + 1) Then wb.Close True
Else
k = k + 1
sh.Rows(k) = shMain.Rows(i).Value
If shMain.Range("C" & i) <> shMain.Range("C" & i + 1) Then wb.Close True
End If
Next
End Sub