Перенос данных на другую страницу с добавлением новых строк

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

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

Sam_nvrsk

Дата: Четверг, 22.08.2013, 17:20 | Сообщение № 1

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

Ранг: Новичок

Сообщений: 23

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

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

Excel 2007

Всем добрый день,

Прошу помочь с макросом по переносу данных с одной страницы на другую, создавая новые строки, сдвигая последующие данные.

Пока работает просто перенос но замещая данные в последующих строках.

[vba]

Код

Sub Transpose()
            Application.ScreenUpdating = False
     Sheets("Time Log").Select
     Range("B43:B52").Select
     Selection.Copy
     Sheets("AGIP form").Select
     Range("A34:A40").Select
     Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
     False, Transpose:=False
     Application.CutCopyMode = False
     Sheets("AGIP form").Select
     Range("A34").Select
End Sub

[/vba]

Скажу честно что понимаю скрипты поверхностно, сделал то что имеется просто переработав чужой скрипт.

И еще, как удалить command button?

Заранее прошу прощения за оформление - не работает всплывающее меню описания темы.

Сообщение отредактировал Sam_nvrsk - Четверг, 22.08.2013, 17:38

Ответить

Sam_nvrsk

Дата: Четверг, 22.08.2013, 17:23 | Сообщение № 2

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

Ранг: Новичок

Сообщений: 23

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

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

Excel 2007

Не пойму почему не прикрепляется файл.

Получилось

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

Сообщение отредактировал Sam_nvrsk - Четверг, 22.08.2013, 17:30

Ответить

Hugo

Дата: Четверг, 22.08.2013, 17:47 | Сообщение № 3

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

Ранг: Участник клуба

Сообщений: 3690

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

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

365

Совершенно не понял, что хотите сделать - объясните задачу подробнее.
А по поводу кнопки - включаете режим Design Mode, выделяете кнопку, удаляете.

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Ответить

Serge_007

Дата: Четверг, 22.08.2013, 17:51 | Сообщение № 4

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

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

Сообщений: 16475

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

Замечаний: ±

Excel 2016

Цитата (Sam_nvrsk, Четверг, 22.08.2013, 17:20 # 1)

не работает всплывающее меню описания темы

Какой браузер, версия? Видео или скрины того как оно не работает можете выложить?

ЮMoney:41001419691823 | WMR:126292472390

Ответить

Sam_nvrsk

Дата: Четверг, 22.08.2013, 18:13 | Сообщение № 5

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

Ранг: Новичок

Сообщений: 23

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

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

Excel 2007

Скрин с ошибкой в приложении.

Подробнее:

Имеется страница с резюмирующими данными, на ней одна строка с надписью No delays.

Если создаются задержки, они указываются в time log.

Хочу чтобы по нажатию кнопки данные преносились на резюмирующий лист замещая строку no delays и добавлялись новые строки, чтоб данные не затирали последующую информацию, желательно чтоб пустые строки на листе time log не копировались.

К сообщению приложен файл: 6887609.png (87.8 Kb) · 8374868.xls (95.5 Kb)

Ответить

Serge_007

Дата: Четверг, 22.08.2013, 20:06 | Сообщение № 6

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

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

Сообщений: 16475

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

Замечаний: ±

Excel 2016

Цитата (Sam_nvrsk, Четверг, 22.08.2013, 18:13 # 5)

Скрин с ошибкой в приложении.

Спасибо, постараюсь исправить

ЮMoney:41001419691823 | WMR:126292472390

Ответить

Sam_nvrsk

Дата: Воскресенье, 25.08.2013, 17:36 | Сообщение № 7

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

Ранг: Новичок

Сообщений: 23

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

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

Excel 2007

Жаль что пока никто не отозвался,

Нашел нужный скрипт, добавляет строку от активной ячейки.

[vba]

Код

Sub Button5_Click()
     If Application.Intersect(ActiveCell, ActiveSheet.UsedRange) Is Nothing _
         Or ActiveCell.Row < 3 Then
             MsgBox "Активная ячейка вне таблицы"
     Else
         Rows(ActiveCell.Row).Insert
         Rows(ActiveCell.Row + 1).Copy Rows(ActiveCell.Row)
     End If
End Sub

[/vba]

но его нужно доработать - чтоб добавлял строки от конкретной ячейки - no delays
И количество добавленных строк равнялось количеству заполненых строк (43-52 строка страницы time log)

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

Ответить

KuklP

Дата: Воскресенье, 25.08.2013, 18:31 | Сообщение № 8

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

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

Сообщений: 2369

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

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

2003-2010

Цитата (Sam_nvrsk, Воскресенье, 25.08.2013, 17:36 # 7)

Жаль что пока никто не отозвался

Жаль, что объясняете непонятно.
[vba]

Код

Sub www()
     Dim r
     On Error GoTo www_Error
     With Sheets("Time Log").[b:b].Find("REMARKS:", , , xlWhole)
         r = .Parent.Range(.Offset(1, 0), .End(xlDown)).Value
     End With
     With Sheets("AGIP form").[a:a].Find("No delays", , , xlWhole)
         .Resize(UBound(r) - 1).Insert xlDown
         .Offset(-UBound(r) + 1).Resize(UBound(r)) = r
     End With
     On Error GoTo 0
     Exit Sub
www_Error:
     MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure www of Module Module2"
End Sub

[/vba]

К сообщению приложен файл: 0539267.rar (28.3 Kb)

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

Wasilich

Дата: Воскресенье, 25.08.2013, 19:24 | Сообщение № 9

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

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

Сообщений: 1232

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

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

2003

Цитата (Sam_nvrsk, Четверг, 22.08.2013, 17:20 # 1)

Пока работает просто перенос но замещая данные в последующих строках.

Добавил в Ваш код всего одну строчку.

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

Сообщение отредактировал Wasilic - Воскресенье, 25.08.2013, 19:25

Ответить

Sam_nvrsk

Дата: Воскресенье, 25.08.2013, 22:30 | Сообщение № 10

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

Ранг: Новичок

Сообщений: 23

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

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

Excel 2007

Цитата (Wasilic, Воскресенье, 25.08.2013, 19:24 # 9)

Добавил в Ваш код всего одну строчку.

В этом случае ячейки из TIME LOG переносятся за последнюю заполенную ячейку. но у меня предполагается что ячейка delays будет не последней.

Цитата (KuklP, Воскресенье, 25.08.2013, 18:31 # 8)

[vba]

Код

Sub www()
Dim r
On Error GoTo www_Error
With Sheets("Time Log").[b:b].Find("REMARKS:", , , xlWhole)
r = .Parent.Range(.Offset(1, 0), .End(xlDown)).Value
End With
With Sheets("AGIP form").[a:a].Find("No delays", , , xlWhole)
.Resize(UBound(r) - 1).Insert xlDown
.Offset(-UBound(r) + 1).Resize(UBound(r)) = r
End With
On Error GoTo 0
Exit Sub
www_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure www of Module Module2"
End Sub

[/vba]

Это очень близко к тому что я хочу, но тут я как понял двигаются ячейки вниз, а мне бы хотелось чтоб двигались строки, так как получается что ячейки заполенные в стороне не двигаются и все сдвигается в разнобой (см приложенный файл)