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

Вход

Регистрация

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

 

= Мир MS Excel/Копирование умной таблицы по условию - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование умной таблицы по условию (Макросы/Sub)
Копирование умной таблицы по условию
juliabaranowa Дата: Понедельник, 14.11.2022, 22:47 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

ДОБРЫЙ ДЕНЬ!
Прошу Вас помощи в решении.
Есть Лист "Расписания" необходимо скопировать на Лист "Погрузка" УТ их на Листе "Расписания 7 шт. в соответствии с днем недели (текущей). И каждое последующее копирование должно происходить на последнюю строку таблицы на Листе "Погрузка". При этом в столбец дата на Листе "Погрузка" должна проставляться дата (д.м.г.). В дальнейшем планируется все это завязать на кнопке "СФОРМИРОВАТЬ".

Пыталась сама, пытала ГУГЛ, ЯНДЕКС, смотрю в книгу "вижу фигу %) :'( " и все это в течении недели..... :( :( :(
К сообщению приложен файл: 2022_11_.xlsm(33.1 Kb)
 
Ответить
СообщениеДОБРЫЙ ДЕНЬ!
Прошу Вас помощи в решении.
Есть Лист "Расписания" необходимо скопировать на Лист "Погрузка" УТ их на Листе "Расписания 7 шт. в соответствии с днем недели (текущей). И каждое последующее копирование должно происходить на последнюю строку таблицы на Листе "Погрузка". При этом в столбец дата на Листе "Погрузка" должна проставляться дата (д.м.г.). В дальнейшем планируется все это завязать на кнопке "СФОРМИРОВАТЬ".

Пыталась сама, пытала ГУГЛ, ЯНДЕКС, смотрю в книгу "вижу фигу %) :'( " и все это в течении недели..... :( :( :(

Автор - juliabaranowa
Дата добавления - 14.11.2022 в 22:47
andreimurysev Дата: Вторник, 15.11.2022, 13:19 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 5 ±
Замечаний: 0% ±

juliabaranowa, попробуйте
К сообщению приложен файл: 3736692.xlsm(38.0 Kb)
 
Ответить
Сообщениеjuliabaranowa, попробуйте

Автор - andreimurysev
Дата добавления - 15.11.2022 в 13:19
doober Дата: Вторник, 15.11.2022, 13:27 | Сообщение № 3
Группа: Друзья
Ранг: Ветеран
Сообщений: 901
Репутация: 314 ±
Замечаний: 0% ±

Excel 2010
Добрый.
Так?[vba]
Код
Sub Copy_week()    'копирование расписаний

    Dim wd As Integer, TableName As String, Rng As Range, Sh1 As Worksheet, Sh As Worksheet

    Set Sh = ThisWorkbook.Worksheets("ПОГРУЗКА")
    Set Sh1 = ThisWorkbook.Worksheets("РАСПИСАНИЯ")
    Monts = Array("", "УТ_ПОНЕДЕЛЬНИК", "УТ_ВТОРНИК", "УТ_СРЕДА", _
                  "УТ_ЧЕТВЕРГ", "УТ_ПЯТНИЦА", "УТ_СУББОТА", "УТ_ВОСКРЕСЕНЬЕ")
    wd = Weekday(Date, vbMonday)
    TableName = Monts(wd)
    Set Rng = Sh1.Range(TableName)
    Set LB = Sh.ListObjects(1)
    LastRow = LB.Range.Row + LB.Range.Rows.Count - 1
    If Sh.Range("G" & LastRow) <> "" Then
        LastRow = LastRow + 1
    End If
    rc = Rng.Rows.Count
    Rng.Copy Sh.Range("G" & LastRow)
    Sh.Range("B" & LastRow).Resize(rc, 1) = Date
    MsgBox ("РАСПИСАНИЯ ДОБАВЛЕНЫ УСПЕШНО!")

End Sub
[/vba]


 
Ответить
СообщениеДобрый.
Так?[vba]
Код
Sub Copy_week()    'копирование расписаний

    Dim wd As Integer, TableName As String, Rng As Range, Sh1 As Worksheet, Sh As Worksheet

    Set Sh = ThisWorkbook.Worksheets("ПОГРУЗКА")
    Set Sh1 = ThisWorkbook.Worksheets("РАСПИСАНИЯ")
    Monts = Array("", "УТ_ПОНЕДЕЛЬНИК", "УТ_ВТОРНИК", "УТ_СРЕДА", _
                  "УТ_ЧЕТВЕРГ", "УТ_ПЯТНИЦА", "УТ_СУББОТА", "УТ_ВОСКРЕСЕНЬЕ")
    wd = Weekday(Date, vbMonday)
    TableName = Monts(wd)
    Set Rng = Sh1.Range(TableName)
    Set LB = Sh.ListObjects(1)
    LastRow = LB.Range.Row + LB.Range.Rows.Count - 1
    If Sh.Range("G" & LastRow) <> "" Then
        LastRow = LastRow + 1
    End If
    rc = Rng.Rows.Count
    Rng.Copy Sh.Range("G" & LastRow)
    Sh.Range("B" & LastRow).Resize(rc, 1) = Date
    MsgBox ("РАСПИСАНИЯ ДОБАВЛЕНЫ УСПЕШНО!")

End Sub
[/vba]

Автор - doober
Дата добавления - 15.11.2022 в 13:27
juliabaranowa Дата: Вторник, 15.11.2022, 22:41 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

andreimurysev, Всё работает как задумывалось! СПАСИБО БОЛЬШОЕ! Это КРУТО!!! hands hands hands
 
Ответить
Сообщениеandreimurysev, Всё работает как задумывалось! СПАСИБО БОЛЬШОЕ! Это КРУТО!!! hands hands hands

Автор - juliabaranowa
Дата добавления - 15.11.2022 в 22:41
juliabaranowa Дата: Вторник, 15.11.2022, 22:44 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

doober, Все работает как было задумано! СПАСИБО БОЛЬШОЕ! hands hands hands
 
Ответить
Сообщениеdoober, Все работает как было задумано! СПАСИБО БОЛЬШОЕ! hands hands hands

Автор - juliabaranowa
Дата добавления - 15.11.2022 в 22:44
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование умной таблицы по условию (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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