Здравствуйте. Нужна помощь по автоматизации отчета. Есть данные которые присылают СМО. Их несколько (СМО 1, СМО 2 итд). Необходимо данные из файлов СМО перенести на отдельный лист в итоговый отчет. По окончании необходимо отсортировать столбец В по лечебным учреждениям. Заранее спасибо. P.S. Если макросом сложно, то можно формулами.
Здравствуйте. Нужна помощь по автоматизации отчета. Есть данные которые присылают СМО. Их несколько (СМО 1, СМО 2 итд). Необходимо данные из файлов СМО перенести на отдельный лист в итоговый отчет. По окончании необходимо отсортировать столбец В по лечебным учреждениям. Заранее спасибо. P.S. Если макросом сложно, то можно формулами.Mark1976
Sub tt() Dim sh As Worksheet Application.ScreenUpdating = 0 r0_ = 4 c0_ = 2 nc_ = 18 r00_ = 8 r01_ = Cells(Rows.Count, 1).End(3).Row If r01_ > r00_ Then Cells(r00_ + 1, 1).Resize(r01_ - r00_ + 1, nc_).Clear End If r01_ = r00_ For Each sh In Worksheets If Left(sh.Name, 3) = "СМО" Then With sh nr_ = .Cells(.Rows.Count, c0_).End(3).Row - r0_ + 1 .Cells(r0_, 1).Resize(nr_, nc_).Copy Cells(r01_ + 1, 1).Resize(nr_, nc_) End With r01_ = Cells(Rows.Count, 1).End(3).Row End If Next sh With Me.AutoFilter.Sort .SortFields.Add Key:=Cells(r00_, 2) .Apply End With Cells(r00_ + 1, 1) = 1 Cells(r00_ + 1, 1).Resize(r01_ - r00_).DataSeries Application.ScreenUpdating = 1 End Sub
[/vba]
Так нужно? [vba]
Код
Sub tt() Dim sh As Worksheet Application.ScreenUpdating = 0 r0_ = 4 c0_ = 2 nc_ = 18 r00_ = 8 r01_ = Cells(Rows.Count, 1).End(3).Row If r01_ > r00_ Then Cells(r00_ + 1, 1).Resize(r01_ - r00_ + 1, nc_).Clear End If r01_ = r00_ For Each sh In Worksheets If Left(sh.Name, 3) = "СМО" Then With sh nr_ = .Cells(.Rows.Count, c0_).End(3).Row - r0_ + 1 .Cells(r0_, 1).Resize(nr_, nc_).Copy Cells(r01_ + 1, 1).Resize(nr_, nc_) End With r01_ = Cells(Rows.Count, 1).End(3).Row End If Next sh With Me.AutoFilter.Sort .SortFields.Add Key:=Cells(r00_, 2) .Apply End With Cells(r00_ + 1, 1) = 1 Cells(r00_ + 1, 1).Resize(r01_ - r00_).DataSeries Application.ScreenUpdating = 1 End Sub
_Boroda_, перенос работает. Но при открытии файла выходят сообщения: 1. Ошибка в части содержимого в книге Выгрузка данных СМО.xlsm. Выполнить попытку восстановления?...... 2. Удаленные записи: Сортировка из части /xl/worksheets/sheet1.xml Что это может быть?
_Boroda_, перенос работает. Но при открытии файла выходят сообщения: 1. Ошибка в части содержимого в книге Выгрузка данных СМО.xlsm. Выполнить попытку восстановления?...... 2. Удаленные записи: Сортировка из части /xl/worksheets/sheet1.xml Что это может быть?Mark1976
_Boroda_, скажите почему на другом компе выходит "ошибка 400" при переносе (перенос при этом происходит)? На моем компе все работает без нареканий.
_Boroda_, скажите почему на другом компе выходит "ошибка 400" при переносе (перенос при этом происходит)? На моем компе все работает без нареканий.Mark1976