Страницы: 1
RSS
Объединить таблицы с разных листов без математических действий (только сдвиг вниз по новым данным)
 
Помогите мне плиз.
Ни как не врублюсь сделать как сделать объединение таблиц с разных листов, но только не применяя к общей таблиц ни каких суммирований и тд.
Просто перенос заполненных ячеек с двух листов в таблицу на листе ОБЩАЯ, так как на одном из листов есть прописанные функции.
То что здесь помогли не вносит в общую таблицу ячейки с условиями.((
Изменено: Антон З - 13.04.2021 10:31:22 (Конкретизировал)
 
Антон З, негде помогать Вам (файл пример нужен с исходными данными и показанным результатом того что хотите видеть на выходе)
Не бойтесь совершенства. Вам его не достичь.
 
Антон З,
Принцип такой:

Сначала заполняет свой журнал ЭТЛ (вносит номера и тд) - Блок ЭТЛ

Потом ОСТ заполняет две страницы в одинаковых журналах - Блок ОСТ:
                                кнопка ВВод данных по СЗ которые требуют испытаний
                                кнопкой ВВод данных СЗ которые не испытываются
                                Далее две страницы эти журналов должны просто объединиться одним большим списком.
Как прописать это?
 
Антон З, что в файле желаемый результат? и уточните  порядок данных что бы понять ...
Изменено: Mershik - 12.04.2021 15:01:54
Не бойтесь совершенства. Вам его не достичь.
 
обе таблицы должны объединиться в одну общую
Изменено: Антон З - 12.04.2021 15:02:47
 
ну ок) не хотите норм показывать ловите как поняЛ)
Код
Sub Кнопка3_Щелчок()
Dim rng As Range, sh As Worksheet, sh2 As Worksheet, sh3 As Worksheet, wh As Worksheet, lr As Long, lr2 As Long
Set sh = Worksheets("журнал ОСТ осмотры")
Set sh2 = Worksheets("журнал ОСТ")
Set sh3 = Worksheets("Общая")
sh3.Range("A3:L100000").Clear
For Each wh In Worksheets
    If wh.Name = sh.Name Or wh.Name = sh2.Name Then
        lr = wh.Cells(Rows.Count, 3).End(xlUp).Row
        lr2 = sh3.Cells(Rows.Count, 3).End(xlUp).Row + 1
        If lr <= 2 Then Exit For
        wh.Range(wh.Cells(3, 1), wh.Cells(lr, 12)).Copy Destination:=sh3.Cells(lr2, 1)
    End If
Next wh
End Sub
Изменено: Mershik - 12.04.2021 15:29:21
Не бойтесь совершенства. Вам его не достичь.
 
Mershik,
макросом хорошо, но есть в этом методе проблема что если нажимать каждый раз кнопку добавляется и то что уже добавили раньше
 
Антон З, странно у меня в приложенном  мною файле такого нет..у вас иначе? файл на всякий случай заменил
Изменено: Mershik - 12.04.2021 15:29:04
Не бойтесь совершенства. Вам его не достичь.
 
Mershik,
я ни как не могу скачать этот файл в этом разрешении (на работе касперский блочит((-
вы сможете его в формате .xlsx сделать , а я у себя пересохраню как с макросами
и гляну хоть
 
Антон З, а смысл? тогда макросы работать не будут...скопируйте макрос себе и все  
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, я с домашнего сейчас открыл да в этом файле работает хорошо
Но....
Меня здесь модератор просил упростить пример в котором надо сделать данное объединение как легкий пример и это сделало мне медвежью услуги, дело в том, что на листе «Журнал Ост» первые четыре столбца имеют функции, которые перешли в общий лист как пустые ячейки((( что теперь делать?
 
Антон З, что сейчас не так с маккросом ? так как файл остался такой же, нужно копировать только значения?  если да
Код
Sub Кнопка3_Щелчок()
Dim rng As Range, sh As Worksheet, sh2 As Worksheet, sh3 As Worksheet, wh As Worksheet, lr As Long, lr2 As Long
Set sh = Worksheets("журнал ОСТ осмотры")
Set sh2 = Worksheets("журнал ОСТ")
Set sh3 = Worksheets("Общая")
sh3.Range("A3:L100000").Clear
For Each wh In Worksheets
    If wh.Name = sh.Name Or wh.Name = sh2.Name Then
        lr = wh.Cells(Rows.Count, 3).End(xlUp).Row
        lr2 = sh3.Cells(Rows.Count, 3).End(xlUp).Row + 1
        If lr <= 2 Then Exit For
        wh.Range(wh.Cells(3, 1), wh.Cells(lr, 12)).Copy
        sh3.Cells(lr2, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
Next wh
End Sub
Изменено: Mershik - 13.04.2021 10:46:41
Не бойтесь совершенства. Вам его не достичь.
 
Mershik,
я так понял вы немного поменяли, но теперь в файле примере значения переносятся, но формат даты сбивается с каждым нажатием(((
а в рабочем файле этот макрос так и ни чего не переносит(((
 
Антон З,
Цитата
Mershik написал: что сейчас не так с маккросом ?
хотите форматы их можно макросом настраивать, но все равно ничего не понятно что не так - в приведеном файле все работает, а то что у вас где-то в другом месте не работает ну увы ничто не идеально. соответственно из правил:
Цитата
2.3. Приложите файл(ы) с примером (общим весом не более 300Кб) в реальной структуре и форматах данных того, что есть сейчас и того, что хотелось бы на выходе.
Не бойтесь совершенства. Вам его не достичь.
 
Mershik,
в том то и проблема, что рабочий файл где нужно использовать этот макрос нельзя сюда прикрепить пишет что он больше 100кб(((
Если вставить последний текст макроса , который вы написали, он переносит даты как 6-ти значное число, а не как даты((
А в рабочем файле получается что он ни чего вообще не переносит, и я не могу понять почему, на одной странице применено заполнение ячеек через функции , а на другой просто внос данных через макрос ФОРМА, вот с этих двух листов ваш макрос не переносит ни какие значения((((
 
Антон З, ну гадать я не буду.. еще раз на всякий случай файл-прмер это не весь ваш файл  
Не бойтесь совершенства. Вам его не достичь.
 
OFF
Mershik, приветствую!
В который раз смотрю за вашими попытками "достучаться" до ТСа и хотелось бы отметить, что терпения (возможно, как и свободного времени  :D ) вам не занимать  8)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, привет)
Цитата
Jack Famous написал:
терпения
сильно не воспринимаю близко к сердцу )))))) - просто иногда хочется поучится чему-то на практике, но увы...
Цитата
Jack Famous написал:
свободного времени  
ой это когда как) рад когда оно действительно преобладает в рабочие будни, а помогает мне в это автоматизация рутинной работы))
Не бойтесь совершенства. Вам его не достичь.
Страницы: 1
Наверх