Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Перенести данные на новый лист макросом. - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Перенести данные на новый лист макросом.
Mark1976 Дата: Суббота, 10.08.2019, 18:03 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 761
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
Здравствуйте. Нужна помощь по автоматизации отчета. Есть данные которые присылают СМО. Их несколько (СМО 1, СМО 2 итд). Необходимо данные из файлов СМО перенести на отдельный лист в итоговый отчет. По окончании необходимо отсортировать столбец В по лечебным учреждениям. Заранее спасибо.
P.S. Если макросом сложно, то можно формулами.
К сообщению приложен файл: __.xlsx (14.5 Kb)


Сообщение отредактировал Mark1976 - Суббота, 10.08.2019, 18:11
 
Ответить
СообщениеЗдравствуйте. Нужна помощь по автоматизации отчета. Есть данные которые присылают СМО. Их несколько (СМО 1, СМО 2 итд). Необходимо данные из файлов СМО перенести на отдельный лист в итоговый отчет. По окончании необходимо отсортировать столбец В по лечебным учреждениям. Заранее спасибо.
P.S. Если макросом сложно, то можно формулами.

Автор - Mark1976
Дата добавления - 10.08.2019 в 18:03
_Boroda_ Дата: Воскресенье, 11.08.2019, 18:29 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 16718
Репутация: 6505 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Так нужно?
[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
[/vba]
К сообщению приложен файл: 18617687.xlsm (29.1 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТак нужно?
[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
[/vba]

Автор - _Boroda_
Дата добавления - 11.08.2019 в 18:29
Mark1976 Дата: Воскресенье, 11.08.2019, 18:51 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 761
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
_Boroda_, спасибо. Это то, что надо.
 
Ответить
Сообщение_Boroda_, спасибо. Это то, что надо.

Автор - Mark1976
Дата добавления - 11.08.2019 в 18:51
Mark1976 Дата: Воскресенье, 11.08.2019, 21:32 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 761
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
_Boroda_, перенос работает. Но при открытии файла выходят сообщения:
1. Ошибка в части содержимого в книге Выгрузка данных СМО.xlsm. Выполнить попытку восстановления?......
2. Удаленные записи: Сортировка из части /xl/worksheets/sheet1.xml
Что это может быть?
К сообщению приложен файл: __.xlsm (30.5 Kb)


Сообщение отредактировал Mark1976 - Воскресенье, 11.08.2019, 21:37
 
Ответить
Сообщение_Boroda_, перенос работает. Но при открытии файла выходят сообщения:
1. Ошибка в части содержимого в книге Выгрузка данных СМО.xlsm. Выполнить попытку восстановления?......
2. Удаленные записи: Сортировка из части /xl/worksheets/sheet1.xml
Что это может быть?

Автор - Mark1976
Дата добавления - 11.08.2019 в 21:32
_Boroda_ Дата: Воскресенье, 11.08.2019, 21:40 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 16718
Репутация: 6505 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
А так?
К сообщению приложен файл: 456465455_1.xlsm (29.9 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеА так?

Автор - _Boroda_
Дата добавления - 11.08.2019 в 21:40
Mark1976 Дата: Воскресенье, 11.08.2019, 21:45 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 761
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
_Boroda_, а так идеально. Спасибо.


Сообщение отредактировал Mark1976 - Воскресенье, 11.08.2019, 23:36
 
Ответить
Сообщение_Boroda_, а так идеально. Спасибо.

Автор - Mark1976
Дата добавления - 11.08.2019 в 21:45
Mark1976 Дата: Вторник, 13.08.2019, 05:21 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 761
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
_Boroda_, скажите почему на другом компе выходит "ошибка 400" при переносе (перенос при этом происходит)? На моем компе все работает без нареканий.
 
Ответить
Сообщение_Boroda_, скажите почему на другом компе выходит "ошибка 400" при переносе (перенос при этом происходит)? На моем компе все работает без нареканий.

Автор - Mark1976
Дата добавления - 13.08.2019 в 05:21
_Boroda_ Дата: Вторник, 13.08.2019, 09:10 | Сообщение № 8
Группа: Админы
Ранг: Местный житель
Сообщений: 16718
Репутация: 6505 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Это очень просто определить - присылайте мне этот "другой" компьютер и я посмотрю :)

В какой строке макроса ругается?

Попробуйте так
К сообщению приложен файл: 456465455_2.xlsm (29.8 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЭто очень просто определить - присылайте мне этот "другой" компьютер и я посмотрю :)

В какой строке макроса ругается?

Попробуйте так

Автор - _Boroda_
Дата добавления - 13.08.2019 в 09:10
Mark1976 Дата: Вторник, 13.08.2019, 09:28 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 761
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, 2013
_Boroda_, спасибо за ответ, попробую с данным файлом. По строке пока не смогу ответить, нахожусь на расстоянии от компа.
 
Ответить
Сообщение_Boroda_, спасибо за ответ, попробую с данным файлом. По строке пока не смогу ответить, нахожусь на расстоянии от компа.

Автор - Mark1976
Дата добавления - 13.08.2019 в 09:28
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!