Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сбор данных с разных листов и вставка значениями
 
#1
13.03.2014 15:32:56
Добрый день!
Достаточно часто пользуюсь замечательным макросом-сбор данных со всех листов файла на один лист.
Но закавыка в том, что данные переносятся в таком виде в котором есть, то есть с формулами, если они есть.
А если есть необходимости переносить только значения, что нужно в код добавить? подскажите, пожалуйста:
Код
Sub SheetConsolidation()
Dim st As Worksheet
Dim Ri As Range
Dim EndRowi As Long
For Each st In ThisWorkbook.Sheets
If st.Name <> "ALL" Then
    With st
     Set Ri = .UsedRange.Offset(1, 0).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
    End With
    With ThisWorkbook.Sheets("ALL")
     EndRowi = .Range("A" & Rows.Count).End(xlUp).Row
          Ri.Copy .Cells(EndRowi + 1, "A")
    End With
End If
Next st
Application.CutCopyMode = False
End Sub
 
 
 
#2
13.03.2014 15:44:53
Используйте при копировании Function PasteSpecial с xlPasteValues
 
 
 
#3
13.03.2014 15:45:42
Имхо
Код
Sub SheetConsolidation()
Dim st As Worksheet
Dim Ri As Range
Dim EndRowi As Long
For Each st In ThisWorkbook.Sheets
If st.Name <> "ALL" Then
With st
Set Ri = .UsedRange.Offset(1, 0).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
End With
With ThisWorkbook.Sheets("ALL")
EndRowi = .Range("A" & Rows.Count).End(xlUp).Row

Ri.Copy .Cells(EndRowi + 1, "A")
Ri.Copy
.Cells(EndRowi + 1, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End With
End If
Next st
Application.CutCopyMode = False
End Sub
 
 
 
#4
13.03.2014 16:27:11
Получилось!
Спасибо большое!
 
 
 
#5
26.03.2014 18:18:33
мучает меня один вопрос очень сильно, и чтобы не плодить тем, а в продолжение этой -  Сбор данных .. и вставка значениями - прошу помочь сделать то же самое, только Листы из разных книг... темы копирования листов на форуме есть очень интересные, НО надо скопировать из др книг именно диапазон ячеек, и вставить эти Ranges в рабочий файл (каков он есть) опр Лист - друг за другом слева направо... как во вложении в итоговом файле "diff source copyF" - лист "from(2)" ... а файлы EC_OptionsF и BP_OptionsF  - соответственно источники... (во вложении)... пыталась сделать макрос, но совсем запуталась (там эти попытки выдают ошибку в работе макроса насколько пыталась наваять)... может кто знает как подправить?.. чтобы соединить эти два кода:

1. отсюда http://www.planetaexcel.ru/techniques/12/49/ (начало для выбора файлов)
2. МатросНаЗебре, ваш - изложенный выше

суть в том, чтобы из файлов источников - листов с одним названием и из одного диапазона (S2:AB43), но разных книг, брать цифры(значения! и форматирование) и вставить в файл-назначения эти диапазоны на лист "from" (файла "diff source copyF") в последовательности слева направо (как на листе "from(2)" ) ... что-то мы с макросом перестали понимать др др, пока я его склеивала... может у кого есть идеи, как поточнее ему высказаться?

p.s. формулы многие заменила на значения (для форума- т к формулы массива- утяжеляют файл, - ну и удалила листы откуда эти формулы подтягивали свои цифры), но проблема всё та же - вставить значениями(ну и форматирование сохранить)... не просто в др лист, а лист др книги... и сделать это надо в рамках цикла №1(начало для выбора файлов)... есть ли идеи?.. или создать новую ветку? (да простят модераторы за бестактный вопрос- не знаю как лучше)
Изменено: JeyCi - 26.03.2014 18:21:06
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#6
27.03.2014 09:17:56
получилась у меня такая модификация кода МатросНаЗебре
выставляет все копируемые диапазоны листов из др файлов др за другом сверху вниз...
значениями и с исходным форматированием...

Код
 ' проходим по все выбранным файлам
Код
      x = 1
    While x <= UBound(FilesToOpen)
     Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
     
      
      
       Set Ri = ActiveWorkbook.Sheets("Results").Range("S2:AB43")
       Ri.Copy
       
      Application.Goto Workbooks("diff source copyF.xlsm").Sheets("from").Cells(2, 2)
      
         With ThisWorkbook.Sheets("from")
           EndRowi = .Range("A" & Rows.Count).End(xlUp).Row
           Ri.Copy .Cells(EndRowi + 1, "A")
           Ri.Copy
          .Cells(EndRowi + 1, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     :=False, Transpose:=False
          .Cells(EndRowi + 1, "A").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
     SkipBlanks:=False, Transpose:=False
         End With
        
                 
      
     importWB.Close savechanges:=False
     x = x + 1
    Wend
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#7
27.03.2014 09:22:04
только 2 вопроса осталось решить! может кто знает, что дописать в код и где?

1. чтобы на листе-назначения "from" сначала Delete всё что на нём есть (включая очистку форматирования) - после чего вставка на него (чистого) данных от работы макроса
2. чтобы диапазоны копируемые вставлялись не сверху вниз друг за другом, а слева на право друг за другом

файл с полным кодом прилагаю
Изменено: JeyCi - 27.03.2014 09:31:45
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#8
27.03.2014 11:28:37
Цитата
1. чтобы на листе-назначения "from" сначала Delete всё что на нём есть (включая очистку форматирования) - после чего вставка на него (чистого) данных от работы макроса
вроде бы такая строка (после выбора файлов и до перебора их) работает  :)  ... по результатам - очень похоже на правду

Код
  ThisWorkbook.Worksheets("from").Cells.Clear  

p.s. остался всего 2-й вопрос выше... если найду ответ раньше, чем кто-нибудь - выскажусь  ;)   строкой из кода... если кто-нибудь выскажется раньше - то победителей не судят  :)
Изменено: JeyCi - 27.03.2014 11:30:46
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#9
27.03.2014 12:05:25
Цитата
JeyCi пишет:
чтобы диапазоны копируемые вставлялись не сверху вниз друг за другом, а слева на право друг за другом
Так находите номер последнего заполненного столбца на листе и вставляйте диапазонами после него каждый раз.
Учусь программировать :)
 
 
 
#10
27.03.2014 12:26:03
Цитата
Smiley пишет:
Так находите номер последнего заполненного столбца на листе и вставляйте диапазонами после него каждый раз.
так я именно это и пытаюсь сделать  :)    - подскажите please где у меня с орфографией ошибка?

Код
 With ThisWorkbook.Sheets("from")
        
        EndColumni = .Range(Columns.Count & 2).End(xlRight).Column
        Ri.Copy .Cells(2, EndColumni + 3)
        Ri.Copy
       .Cells(2, EndColumni + 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     :=False, Transpose:=False
       .Cells(2, EndColumni + 3).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
     SkipBlanks:=False, Transpose:=False
 End With

говорит мне, что я  EndColumni неправильно прописала  :(   (2-я строка)
Изменено: JeyCi - 27.03.2014 12:26:30
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#11
27.03.2014 12:40:00
Цитата
JeyCi пишет:
говорит мне, что яEndColumni неправильно прописала (2-я строка)
попробуйте тут почитать
Учусь программировать :)
 
 
 
#12
27.03.2014 13:12:31
самую простую ошибку исправила - но всё равно макрос не понимает эту строку - даже если её написать с верным синтаксисом
Код
 EndColumni = .Range(Columns.Count & 4).End(xlToLeft).Column

варианты, прописанные по ссылке Smiley с ячейками - тестирую... пока никак... если кто-то уже имел дело с последним столбцом, выложенный код порадует глаз больше, чем мои пробы в vba - поскольку я с ним очень слабо знакома... вобщем эксперименты продолжаю, но свежим идеям тоже буду очень рада

p.s. за исправление ошибки моего синтаксиса Smiley спсибо, будем искать дальше...
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#13
27.03.2014 14:53:10
вот пытаюсь прописать вариант по ссылке Smiley в таком виде:

Код
 With ThisWorkbook.Sheets("from")
        
        a = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        
        Ri.Copy .Cells(2, a + 3)
        Ri.Copy
       .Cells(2, a + 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     :=False, Transpose:=False
       .Cells(2, a + 3).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
     SkipBlanks:=False, Transpose:=False
  End With

но не знаю как назначить эту "a" в начале... Range - не подходит
Код
 Dim a As ??

может поэтому макрос ничего не понимает? а как правильно сделать?
Изменено: JeyCi - 27.03.2014 14:54:19
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#14
27.03.2014 15:00:07
Код
Dim a As Long
Учусь программировать :)
 
 
 
#15
27.03.2014 16:19:31
тоже не подходит - не нравится ему это a= ... вариант (по краю 9-й строки заполненной ячейки)

Код
 EndColumni = .Cells(Columns.Count & 9).End(xlToLeft).Column

вроде даёт результат, но с фокусировкой у него какие-то проблемы... часть диапазона накладывается на 1-ый скопированный (последние его 4 столбца)

p/s/ думаю про какой-нибудь Offset  -  но пока не знаю куда и как вставить... имхо - диапазоны ведь из источника стандартного размера (S2:AB43)
Изменено: JeyCi - 27.03.2014 16:29:54
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#16
27.03.2014 16:41:09
Цитата
JeyCi пишет:
тоже не подходит - не нравится ему это a=
Хм, у меня все работает...
Учусь программировать :)
 
 
 
#17
27.03.2014 17:06:52
видимо, не для моей ситуации - (вкладываю файлы) - 2 файла источника и 1 файл с макросами:
1.макрос с пометкой MY- выкидывает данные на лист error - чтобы увидеть его проблемы с фокусировкой (описанные ранее),
2. макрос просто CombineWorkbooks - с использованием "a" по принципу описанному вами c выбросом на лист "from" - чего-то для моей ситуации не подходит...

а надо чтобы было как на листе "from2"... как-то так??
Изменено: JeyCi - 28.03.2014 01:01:20
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#18
27.03.2014 18:34:32
Smiley  вы вырываетесь вперёд   :)   ... после того, как я приспособила ваш подход к поиску последней заполненной колонки (оказалось, что надо было просто заполнить хоть одну ячейку до начала работы цикла)... то у меня сразу же перестала работать функция  в начале работы макроса...

Код
 ThisWorkbook.Worksheets("from").Cells.Clear  
(чтобы стирать старые данные и собирать заново)
теперь снова решаю первую задачу... значит программирование это не только умение писать циклы... но и вынужденность жить циклично  :|
Изменено: JeyCi - 28.03.2014 01:01:35
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#19
27.03.2014 19:12:54
Цитата
JeyCi пишет:
вынужденность жить циклично
вопрос решён расположением в начале макроса строк

Код
 ThisWorkbook.Worksheets("from").Cells.Clear
    ThisWorkbook.Worksheets("from").Range("A1").Value = 1

день прожит не зря... счёт 1:1... победила дружба   :)  

Цитата
JeyCi пишет:
победителей не судят  :)  
Изменено: JeyCi - 27.03.2014 19:15:36
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
#20
28.03.2014 13:17:09
P.S. есть ещё очень интересные вещи здесь
... для информации... и доработки (кому понадобится)
Изменено: JeyCi - 28.03.2014 13:20:38
чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок - обратитесь к собеседнику на ВЫ - ответ на ваш вопрос получите - а остальное вас не касается (п.п.п. на форумах)
 
 
 
Страницы: 1
Наверх