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

Вход

Регистрация

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

 

= Мир MS Excel/Перенести данные с одинаковых таблиц в одну таблицу - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Перенести данные с одинаковых таблиц в одну таблицу
Ermak27 Дата: Понедельник, 14.01.2013, 09:30 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Здравствуйте возникла такая проблема мне нужно вывести с трех листов в итоговый лист все данные. Есть книга в ней три листа с одинаковой таблице для заполнения и четвертый лист для вывода общего с трех таблиц. Я выложил файл для наглядности, в моем примере строки заполняются с 13 по 17, остальные строки остаются неизменные, но строки могу увеличиваться до n количества, еще итоговая страница защищена паролем 111222. Подскажите пожалуйста как быть!
К сообщению приложен файл: 3831295.zip (46.5 Kb)
 
Ответить
СообщениеЗдравствуйте возникла такая проблема мне нужно вывести с трех листов в итоговый лист все данные. Есть книга в ней три листа с одинаковой таблице для заполнения и четвертый лист для вывода общего с трех таблиц. Я выложил файл для наглядности, в моем примере строки заполняются с 13 по 17, остальные строки остаются неизменные, но строки могу увеличиваться до n количества, еще итоговая страница защищена паролем 111222. Подскажите пожалуйста как быть!

Автор - Ermak27
Дата добавления - 14.01.2013 в 09:30
KuklP Дата: Понедельник, 14.01.2013, 14:24 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Я дико извиняюсь, но надоело просто тупо выполнять ваши заказы. Примеров на подобных форумах полно.
Вот недавний: http://forum.msexcel.ru/index.php/topic,7217.0.html
См. Ответ #19. Легко адаптируется под Ваши условия.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеЯ дико извиняюсь, но надоело просто тупо выполнять ваши заказы. Примеров на подобных форумах полно.
Вот недавний: http://forum.msexcel.ru/index.php/topic,7217.0.html
См. Ответ #19. Легко адаптируется под Ваши условия.

Автор - KuklP
Дата добавления - 14.01.2013 в 14:24
Ermak27 Дата: Понедельник, 14.01.2013, 15:29 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

KuklP, Мне надо не книги, а листы, я видел этот пример но он мне не подошел, я уже 2 недели мучаюсь с этим можете подсказать как сделать
 
Ответить
СообщениеKuklP, Мне надо не книги, а листы, я видел этот пример но он мне не подошел, я уже 2 недели мучаюсь с этим можете подсказать как сделать

Автор - Ermak27
Дата добавления - 14.01.2013 в 15:29
KuklP Дата: Понедельник, 14.01.2013, 15:50 | Сообщение № 4
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Там не книги, а книга. Чтоб собирало само в себе, поменять:
[vba]
Код
Public Sub www()
     Dim sh As Worksheet
     For Each sh In GetObject("J:\ОКС\COMMON\Хомченко Е.В\НОВЫЕ ГРАФИКИ\СВЕРКА.xlsx").Worksheets
         sh.Range(sh.[a5], sh.[a1048576].End(xlUp)).Resize(, 6).Copy _
                 ThisWorkbook.Sheets("Проекты").[a1048576].End(xlUp)(2)
     Next
     Workbooks(Dir("J:\ОКС\COMMON\Хомченко Е.В\НОВЫЕ ГРАФИКИ\СВЕРКА.xlsx")).Close 0
End Sub
[/vba]
GetObject("J:\ОКС\COMMON\Хомченко Е.В\НОВЫЕ ГРАФИКИ\СВЕРКА.xlsx") на thisworkbook
убрать: Workbooks(Dir("J:\ОКС\COMMON\Хомченко Е.В\НОВЫЕ ГРАФИКИ\СВЕРКА.xlsx")).Close 0
и добавить проверку на итоговый лист, чтоб он сам себя в себя не копировал. Естественно, диапазон копирования изменить на свой. Все!
Если уж с такими пустяками не справляетесь, на форуме есть раздел "Работа" и у форумчан-профессионалов в подписях есть имейлы. Обращайтесь.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеТам не книги, а книга. Чтоб собирало само в себе, поменять:
[vba]
Код
Public Sub www()
     Dim sh As Worksheet
     For Each sh In GetObject("J:\ОКС\COMMON\Хомченко Е.В\НОВЫЕ ГРАФИКИ\СВЕРКА.xlsx").Worksheets
         sh.Range(sh.[a5], sh.[a1048576].End(xlUp)).Resize(, 6).Copy _
                 ThisWorkbook.Sheets("Проекты").[a1048576].End(xlUp)(2)
     Next
     Workbooks(Dir("J:\ОКС\COMMON\Хомченко Е.В\НОВЫЕ ГРАФИКИ\СВЕРКА.xlsx")).Close 0
End Sub
[/vba]
GetObject("J:\ОКС\COMMON\Хомченко Е.В\НОВЫЕ ГРАФИКИ\СВЕРКА.xlsx") на thisworkbook
убрать: Workbooks(Dir("J:\ОКС\COMMON\Хомченко Е.В\НОВЫЕ ГРАФИКИ\СВЕРКА.xlsx")).Close 0
и добавить проверку на итоговый лист, чтоб он сам себя в себя не копировал. Естественно, диапазон копирования изменить на свой. Все!
Если уж с такими пустяками не справляетесь, на форуме есть раздел "Работа" и у форумчан-профессионалов в подписях есть имейлы. Обращайтесь.

Автор - KuklP
Дата добавления - 14.01.2013 в 15:50
Ermak27 Дата: Понедельник, 14.01.2013, 20:55 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Подскажите мне пожалуйста как в этом коде исправить так чтобы при сборе данных он не копировал таблицу а собирал все в одну

[vba]
Код
Option Explicit
Const rrow = 11

Sub www()
     Dim r As Range, sh As Worksheet, ind&
     Application.ScreenUpdating = False

     Range("a" & rrow & ":ep" & Cells(rrow, 6).End(xlDown).Row).Clear
     For Each sh In Worksheets
         With sh
             If .Index <> ActiveSheet.Index Then
                 Set r = .Range("a" & rrow & ":ep" & .Cells(.Rows.Count, 2).End(xlUp).Row)
                 r.Copy Cells(rrow + ind, 1)
                 ind = ind + r.Rows.Count
             End If
         End With
     Next

     Application.ScreenUpdating = True

End Sub
[/vba]
 
Ответить
СообщениеПодскажите мне пожалуйста как в этом коде исправить так чтобы при сборе данных он не копировал таблицу а собирал все в одну

[vba]
Код
Option Explicit
Const rrow = 11

Sub www()
     Dim r As Range, sh As Worksheet, ind&
     Application.ScreenUpdating = False

     Range("a" & rrow & ":ep" & Cells(rrow, 6).End(xlDown).Row).Clear
     For Each sh In Worksheets
         With sh
             If .Index <> ActiveSheet.Index Then
                 Set r = .Range("a" & rrow & ":ep" & .Cells(.Rows.Count, 2).End(xlUp).Row)
                 r.Copy Cells(rrow + ind, 1)
                 ind = ind + r.Rows.Count
             End If
         End With
     Next

     Application.ScreenUpdating = True

End Sub
[/vba]

Автор - Ermak27
Дата добавления - 14.01.2013 в 20:55
RAN Дата: Понедельник, 14.01.2013, 21:58 | Сообщение № 6
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
r.Copy ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Offset(1)
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
r.Copy ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Offset(1)
[/vba]

Автор - RAN
Дата добавления - 14.01.2013 в 21:58
Ermak27 Дата: Понедельник, 14.01.2013, 23:12 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Что не то, у меня в таблицах есть итоговая строка желтого цвета и она тоже повторяется а она не должна повторяться, и почему то сдвигается сдвигается на один столбец в перед. Подскажите как сделать? sad
 
Ответить
СообщениеЧто не то, у меня в таблицах есть итоговая строка желтого цвета и она тоже повторяется а она не должна повторяться, и почему то сдвигается сдвигается на один столбец в перед. Подскажите как сделать? sad

Автор - Ermak27
Дата добавления - 14.01.2013 в 23:12
  • Страница 1 из 1
  • 1
Поиск:

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