Перенос таблицы на другой лист ниже ранее заполненных - Мир MS Excel

Регистрация

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

= Мир MS Excel/Перенос таблицы на другой лист ниже ранее заполненных - Мир MS Excel

Старая форма входа

Страница 1 из 2 1 2 »
Модератор форума: китин, _Boroda_

Перенос таблицы на другой лист ниже ранее заполненных (Макросы/Sub)

Перенос таблицы на другой лист ниже ранее заполненных

Дата: Суббота, 14.11.2015, 11:49 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 88

Репутация: 0 ±

Замечаний: 20% ±

2003, 2007 RUS

Здравствуйте! Документ для сменных работников. Возможно ли сделать так, чтобы после завершения смены, при нажатии кнопки «Сохранить»(красная) вся таблица копировалась на лист «01.11.2015» ниже сгруппированных предыдущих смен (группировка копируемой таблицы), с последующим очищением информации белых ячеек на листе «Рабочий» для следующей смены.

[moder]У Вас 3 разных вопроса - это 3 темы должно быть.

К сообщению приложен файл: 4901700.xlsx (21.7 Kb)

Сообщение отредактировал Palladium - Суббота, 14.11.2015, 14:48

Ответить

Дата: Суббота, 14.11.2015, 14:48 | Сообщение № 2

Группа: Пользователи

Ранг: Участник

Сообщений: 88

Репутация: 0 ±

Замечаний: 20% ±

2003, 2007 RUS

Цитата Palladium, 14.11.2015 в 11:49, в сообщении № 1

Модератор:

Исправил. Прошу прощения!

Ответить

Дата: Суббота, 14.11.2015, 15:23 | Сообщение № 3

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

Репутация: 6481 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Такой вариант
[vba]

Код

Sub vstav()
    Application.ScreenUpdating = 0
    Range("A1:J56").Copy
    With Sheets("01.11.2015")
        r1_ = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A" & r1_).PasteSpecial (xlPasteValues)
        .Range("A" & r1_).PasteSpecial (xlPasteFormats)
        .Rows(r1_ & ":" & r1_ + 54).Rows.Group
    End With
    Application.ScreenUpdating = 1
End Sub

[/vba]

К сообщению приложен файл: 4901700_1.xlsm (30.5 Kb)

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

Ответить

Дата: Суббота, 14.11.2015, 16:28 | Сообщение № 4

Группа: Пользователи

Ранг: Участник

Сообщений: 88

Репутация: 0 ±

Замечаний: 20% ±

2003, 2007 RUS

Совершенно верно! Спасибо!

Цитата _Boroda_, 14.11.2015 в 15:23, в сообщении № 3

Такой вариант

Совершенно верно! Спасибо! А автоматическое очищение белых ячеек на листе "Рабочий" возможно? Или лучше это делать вручную? Пробовал добавить [vba]

Код

Sheets("Рабочий").Select
Cells.ClearContents

[/vba] но очищает и желтые тоже, а если защищаю желтые ячейки, то VBA ругается.

Сообщение отредактировал Palladium - Суббота, 14.11.2015, 18:11

Ответить

Дата: Суббота, 14.11.2015, 21:25 | Сообщение № 5

Группа: Проверенные

Ранг: Ветеран

Сообщений: 712

Репутация: 156 ±

Замечаний: 0% ±

Excel 2003

Цитата

но очищает и желтые тоже

Добавьте в код следующий фрагмент после End With
Ячейку А1 тоже надо очищать?
[vba]

Код

    Dim iCell As Range
    For Each iCell In Sheets("Рабочий").Range("C3:J55")
      If iCell.Interior.ColorIndex = -4142 Then
        iCell = ""
      End If
    Next

[/vba]

Ответить

Дата: Суббота, 14.11.2015, 21:35 | Сообщение № 6

Группа: Пользователи

Ранг: Участник

Сообщений: 88

Репутация: 0 ±

Замечаний: 20% ±

2003, 2007 RUS

Цитата Kuzmich, 14.11.2015 в 21:25, в сообщении № 5

Ячейку А1

А1 очищать надо. Новая смена будет прописывать новую дату и фамилию. Сейчас проверить не могу, я с телефона здесь. Завтра попробую. Спасибо!

Сообщение отредактировал Palladium - Суббота, 14.11.2015, 21:39

Ответить

Дата: Суббота, 14.11.2015, 22:05 | Сообщение № 7

Группа: Проверенные

Ранг: Ветеран

Сообщений: 712

Репутация: 156 ±

Замечаний: 0% ±

Excel 2003

Цитата

А1 очищать надо

Тогда добавьте в код еще строчку
[vba]

Код

Sheets("Рабочий").Range("A1")=""

[/vba]

Ответить

Дата: Суббота, 14.11.2015, 23:40 | Сообщение № 8

Группа: Пользователи

Ранг: Участник

Сообщений: 88

Репутация: 0 ±

Замечаний: 20% ±

2003, 2007 RUS

Цитата Kuzmich, 14.11.2015 в 22:05, в сообщении № 7

Тогда

А если просто исправить "C3" на "A1"?

Ответить

Дата: Воскресенье, 15.11.2015, 01:04 | Сообщение № 9

Группа: Проверенные

Ранг: Ветеран

Сообщений: 712

Репутация: 156 ±

Замечаний: 0% ±

Excel 2003

Так попробуйте, у вас А1 - объединенная ячейка

Ответить

Дата: Воскресенье, 15.11.2015, 06:45 | Сообщение № 10

Группа: Пользователи

Ранг: Участник

Сообщений: 88

Репутация: 0 ±

Замечаний: 20% ±

2003, 2007 RUS

Цитата Kuzmich, 15.11.2015 в 01:04, в сообщении № 9

попробуйте

Прийду домой, попробую. Спасибо!!!

Ответить

Дата: Воскресенье, 15.11.2015, 11:06 | Сообщение № 11

Группа: Пользователи

Ранг: Участник

Сообщений: 88

Репутация: 0 ±

Замечаний: 20% ±

2003, 2007 RUS

Цитата Kuzmich, 15.11.2015 в 01:04, в сообщении № 9

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

Попробовал и все работает, но после защиты всех желтых ячеек на листе "Рабочий" от редактирования на вкладке "Рецензирование" кнопка "Перенести" не работает: просит снять защиту. И сразу по защите еще вопрос: надо, чтобы были защищены все желтые на листе "01.11.2015", а группировка работала. Такое возможно? Или что я делаю не так? Может сначала защитить лист, а потом вписать макрос? Вопросы, наверное глупые, но я с макросом столкнулся только недавно и тем более не изучал програмирование.

Ответить

Дата: Воскресенье, 15.11.2015, 11:22 | Сообщение № 12

Группа: Проверенные

Ранг: Ветеран

Сообщений: 712

Репутация: 156 ±

Замечаний: 0% ±

Excel 2003

Цитата

просит снять защиту

В макросе вводите фрагмент снятия защиты, делаете свои действия по переносу
и очистке, затем возвращаете защиту

Ответить

Дата: Воскресенье, 15.11.2015, 11:30 | Сообщение № 13

Группа: Пользователи

Ранг: Участник

Сообщений: 88

Репутация: 0 ±

Замечаний: 20% ±

2003, 2007 RUS

Цитата Kuzmich, 15.11.2015 в 11:22, в сообщении № 12

фрагмент снятия защиты

Вот макрос [vba]

Код

Sub vstav()
    Application.ScreenUpdating = 0
    Range("A1:J56").Copy
    With Sheets("01.11.2015")
        r1_ = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A" & r1_).PasteSpecial (xlPasteValues)
        .Range("A" & r1_).PasteSpecial (xlPasteFormats)
        .Rows(r1_ & ":" & r1_ + 54).Rows.Group
    End With
    Dim iCell As Range
    For Each iCell In Sheets("Рабочий").Range("A1:J55")
    If iCell.Interior.ColorIndex = -4142 Then
        iCell = ""
    End If
    Next
    Application.ScreenUpdating = 1
End Sub

[/vba]
куда и что нужно ввести, если пароль для защиты листа: 1111112

Сообщение отредактировал Palladium - Воскресенье, 15.11.2015, 11:34

Ответить

Дата: Воскресенье, 15.11.2015, 12:03 | Сообщение № 14

Группа: Проверенные

Ранг: Ветеран

Сообщений: 712

Репутация: 156 ±

Замечаний: 0% ±

Excel 2003

В начало кода, попробуйте
[vba]

Код

   If Sheets("Рабочий").ProtectContents=True Then
       Unprotect Password:="1111112"
   End If

[/vba]

В конце код
[vba]

Код

If Sheets("Рабочий").ProtectContents=False Then
Protect Password:="1111112"
End If

[/vba]

Ответить

Дата: Воскресенье, 15.11.2015, 12:20 | Сообщение № 15

Группа: Пользователи

Ранг: Участник

Сообщений: 88

Репутация: 0 ±

Замечаний: 20% ±

2003, 2007 RUS

Цитата Kuzmich, 15.11.2015 в 12:03, в сообщении № 14

В начало кода

Как то так? [vba]

Код

Sub vstav()
If Sheets("Рабочий").ProtectContents = True Then
Unprotect Password:="1111112"
End If
Next
Application.ScreenUpdating = 0
Range("A1:J56").Copy
With Sheets("01.11.2015")
r1_ = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & r1_).PasteSpecial (xlPasteValues)
.Range("A" & r1_).PasteSpecial (xlPasteFormats)
.Rows(r1_ & ":" & r1_ + 54).Rows.Group
End With
Dim iCell As Range
For Each iCell In Sheets("Рабочий").Range("A1:J55")
If iCell.Interior.ColorIndex = -4142 Then
iCell = ""
End If
Next
Application.ScreenUpdating = 1
Next
If Sheets("Рабочий").ProtectContents = False Then
Protect Password:="1111112"
End If
End Sub

[/vba]
Ругается!

Сообщение отредактировал Palladium - Воскресенье, 15.11.2015, 12:21

Ответить

Дата: Воскресенье, 15.11.2015, 12:42 | Сообщение № 16

Группа: Админы

Ранг: Местный житель

Сообщений: 19209

Репутация: 4426 ±

Замечаний: ±

Excel 365 & Mac Excel

Какие-то лишние Next перед[vba]

Код

Application.ScreenUpdating = 0

[/vba] и после [vba]

Код

Application.ScreenUpdating = 1

[/vba]

[p.s.]Почему эта проблема обсуждается в теме "Перенос таблицы..."?[/p.s.]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

Дата: Воскресенье, 15.11.2015, 14:30 | Сообщение № 17

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

Репутация: 326 ±

Замечаний: 0% ±

2003

Если не так, перетакивать не буду.

К сообщению приложен файл: PalladiumN.xls (70.5 Kb)

Ответить

Дата: Воскресенье, 15.11.2015, 15:20 | Сообщение № 18

Группа: Пользователи

Ранг: Участник

Сообщений: 88

Репутация: 0 ±

Замечаний: 20% ±

2003, 2007 RUS

Цитата Pelena, 15.11.2015 в 12:42, в сообщении № 16

Почему эта

Простите! Как бы в продолжении работы с файлом.

Цитата Wasilic, 15.11.2015 в 14:30, в сообщении № 17

перетакивать не буду.

Посижу пощелкаю, попробую разобраться как это сделано. Спасибо!

Ответить

Дата: Понедельник, 16.11.2015, 07:14 | Сообщение № 19

Группа: Пользователи

Ранг: Участник

Сообщений: 88

Репутация: 0 ±

Замечаний: 20% ±

2003, 2007 RUS

Цитата Wasilic, 15.11.2015 в 14:30, в сообщении № 17

Если не так

С каждым вторым нажатием на кнопку перенос выскакивает окно

Сообщение отредактировал Palladium - Понедельник, 16.11.2015, 07:17

Ответить

Дата: Понедельник, 16.11.2015, 09:41 | Сообщение № 20

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

При снятии зашиты листа теряется содержимое буфера обмена.
Не знаю, это глюк файла, или так и быть должно, разбираться лень.
Исправьте
[vba]

Код

   Range("A2:J57").Copy
   Sheets(месяц).Select
   ActiveSheet.Unprotect Password:="1111112"

[/vba]
на
[vba]

Код

   Sheets(месяц).Unprotect Password:="1111112"
   Range("A2:J57").Copy
   Sheets(месяц).Select

[/vba]

Быть или не быть, вот в чем загвоздка!

Ответить

Перенос таблицы на другой лист ниже ранее заполненных (Макросы/Sub)

Страница 1 из 2
1
2
»

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