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

Вход

Регистрация

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

 

= Мир MS Excel/дополнить код копирование данных на лист опред.столбцы - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 3123»
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » дополнить код копирование данных на лист опред.столбцы (Макросы/Sub)
дополнить код копирование данных на лист опред.столбцы
lebensvoll Дата: Понедельник, 19.09.2016, 15:16 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
Добрый день многоуважаемые форумчане!!!
Прошу вас помощи вновь :'( помогите пожалуйста!!!
Имеется таблица (оператор заполняет данную таблицу через USERFORM)
[img][/img]
после заполнения данных "оператор" нажимает на кнопку и происходит перенос данных на другой лист (в общий журнал) код:
[vba]
Код
q = MsgBox("Вы уверены что хотите сохранить данные в журнал заявок???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий
'Код для сохранения данных в общий журнал реестра
    Dim shSheetf As Worksheet
    Dim shSheett As Worksheet
' Dim lStartSheet_("Подтверждение заявок для УПТК") As Long, lEndSheet_("Подтверждение заявок для УПТК") As Long
    Dim lLastRow As Long
    Dim i As Long
    'Даём листам имена "("Подтверждение заявок для УПТК")" и "shSheet_("Общий журнал заявок для УПТК")",
    'чтобы было удобнее писать код.
    Set shSheetf = Worksheets("Подтверждение заявок для УПТК")
    Set shSheett = Worksheets("Общий журнал заявок для УПТК")
    lStartSheet = 8
    lEndSheet = shSheetf.Cells(Rows.Count, 1).End(xlUp).Row
    'Указываем, с какой строки начать вставлять данные на второй лист.
    lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
    'Двигаем по первому листу по столбцу "A".
For i = lStartSheet To lEndSheet
        If Not shSheetf.Cells(i, 2).Value = Empty Then
            'Переносим данные на второй лист.
            shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value
            For X = 1 To 12
        shSheett.Cells(lLastRow, X + 1).Value = shSheetf.Cells(i, X).Value
        Next X
            'Изменяем переменную "lLastRow",
            'чтобы данные уже вставлять в следующую строку.
            lLastRow = lLastRow + 1
        End If
    Next i
            Range(Cells(8, 1), Cells(lEndSheet, 60)).ClearContents
    MsgBox "ДАННЫЕ ПЕРЕНЕСЕНЫ НА ЛИСТ ЖУРНАЛА ЗАЯВОК..."
[/vba]
Посидев совместно с "операторами" пришли к тому что: А можно ли при нажатии данной кнопки чтоб не только переносились эти данные на другой лист в общий журнал. А также производилось частичное копирование данных также на другие листы (перед тем когда эти данные перенесутся в общий журнал)!?
Я попытался это сделать через "запись макроса" но сомневаюсь что правильно это сделал :( а также боюсь не верно этот код внести в существующий).
[vba]
Код
Sub Макрос1()
' Макрос1 Макрос
    Range("A8:E60").Select
    Selection.Copy
    Sheets("План Факт по заявке").Select
    Range("A6").Select
    ActiveSheet.Paste
    Sheets("Подтверждение заявок для УПТК").Select
    Range("F8:F60").Select
    Range("F60").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("План Факт по заявке").Select
    Range("G6").Select
    ActiveSheet.Paste
    Sheets("Подтверждение заявок для УПТК").Select
    Range("I8:I60").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("План Факт по заявке").Select
    Range("J6").Select
    ActiveSheet.Paste
End Sub
[/vba]
Примерная таблица другого листа
[img][/img]
и таких листов будет еще несколько (куда должны будут копироваться нужные столбцы (затем оператор просто переходя на нужные ему листы в течении смены сможет отредактировать полученные данные дополнить новыми и потом уже переносить их в общие журналы).
Прошу меня простить но файл не прилагаю (((( слишком много все весит ((((
заранее спасибо вам огромнейшее


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеДобрый день многоуважаемые форумчане!!!
Прошу вас помощи вновь :'( помогите пожалуйста!!!
Имеется таблица (оператор заполняет данную таблицу через USERFORM)
[img][/img]
после заполнения данных "оператор" нажимает на кнопку и происходит перенос данных на другой лист (в общий журнал) код:
[vba]
Код
q = MsgBox("Вы уверены что хотите сохранить данные в журнал заявок???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий
'Код для сохранения данных в общий журнал реестра
    Dim shSheetf As Worksheet
    Dim shSheett As Worksheet
' Dim lStartSheet_("Подтверждение заявок для УПТК") As Long, lEndSheet_("Подтверждение заявок для УПТК") As Long
    Dim lLastRow As Long
    Dim i As Long
    'Даём листам имена "("Подтверждение заявок для УПТК")" и "shSheet_("Общий журнал заявок для УПТК")",
    'чтобы было удобнее писать код.
    Set shSheetf = Worksheets("Подтверждение заявок для УПТК")
    Set shSheett = Worksheets("Общий журнал заявок для УПТК")
    lStartSheet = 8
    lEndSheet = shSheetf.Cells(Rows.Count, 1).End(xlUp).Row
    'Указываем, с какой строки начать вставлять данные на второй лист.
    lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
    'Двигаем по первому листу по столбцу "A".
For i = lStartSheet To lEndSheet
        If Not shSheetf.Cells(i, 2).Value = Empty Then
            'Переносим данные на второй лист.
            shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value
            For X = 1 To 12
        shSheett.Cells(lLastRow, X + 1).Value = shSheetf.Cells(i, X).Value
        Next X
            'Изменяем переменную "lLastRow",
            'чтобы данные уже вставлять в следующую строку.
            lLastRow = lLastRow + 1
        End If
    Next i
            Range(Cells(8, 1), Cells(lEndSheet, 60)).ClearContents
    MsgBox "ДАННЫЕ ПЕРЕНЕСЕНЫ НА ЛИСТ ЖУРНАЛА ЗАЯВОК..."
[/vba]
Посидев совместно с "операторами" пришли к тому что: А можно ли при нажатии данной кнопки чтоб не только переносились эти данные на другой лист в общий журнал. А также производилось частичное копирование данных также на другие листы (перед тем когда эти данные перенесутся в общий журнал)!?
Я попытался это сделать через "запись макроса" но сомневаюсь что правильно это сделал :( а также боюсь не верно этот код внести в существующий).
[vba]
Код
Sub Макрос1()
' Макрос1 Макрос
    Range("A8:E60").Select
    Selection.Copy
    Sheets("План Факт по заявке").Select
    Range("A6").Select
    ActiveSheet.Paste
    Sheets("Подтверждение заявок для УПТК").Select
    Range("F8:F60").Select
    Range("F60").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("План Факт по заявке").Select
    Range("G6").Select
    ActiveSheet.Paste
    Sheets("Подтверждение заявок для УПТК").Select
    Range("I8:I60").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("План Факт по заявке").Select
    Range("J6").Select
    ActiveSheet.Paste
End Sub
[/vba]
Примерная таблица другого листа
[img][/img]
и таких листов будет еще несколько (куда должны будут копироваться нужные столбцы (затем оператор просто переходя на нужные ему листы в течении смены сможет отредактировать полученные данные дополнить новыми и потом уже переносить их в общие журналы).
Прошу меня простить но файл не прилагаю (((( слишком много все весит ((((
заранее спасибо вам огромнейшее

Автор - lebensvoll
Дата добавления - 19.09.2016 в 15:16
Szekerfehesvar Дата: Понедельник, 19.09.2016, 15:48 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 6 ±
Замечаний: 20% ±

Excel 2013
Можно чуть изменить Ваш же код:
[vba]
Код
Sub Макрос1()
' Макрос1 Макрос
   s=cells(rows.count,1).end(xlup).row
    Range("A8:E" & s).Select
    Selection.Copy
    Sheets("План Факт по заявке").Select
    Range("A6").Select
    ActiveSheet.Paste
    Sheets("Подтверждение заявок для УПТК").Select
    Range("F8:F" & s).Select
    Range("F60").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("План Факт по заявке").Select
    Range("G6").Select
    ActiveSheet.Paste
    Sheets("Подтверждение заявок для УПТК").Select
    Range("I8:I" & s).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("План Факт по заявке").Select
    Range("J6").Select
    ActiveSheet.Paste
End Sub
[/vba]
Таким образом получим, что копироваться будут не только данные до 60 строки, а все те, что есть (больше или меньше - роли не играет)
чтобы корректно его добавить в существующий макрос, добавьте к нему в начало строку [vba]
Код
Sheets("Исходный лист").select
[/vba] и добавьте перед последней строкой (Где у Вас Msgbox)

P.S. предложил максимально простой вариант для реализации без каких либо особых навыков, S в этом коде вычисляет последнюю занятую строку в 1 столбце, соответственно, если у Вас несколько листов, то по аналогии, я думаю, уже сможете остальное сделать сами.


Сообщение отредактировал Szekerfehesvar - Понедельник, 19.09.2016, 15:53
 
Ответить
СообщениеМожно чуть изменить Ваш же код:
[vba]
Код
Sub Макрос1()
' Макрос1 Макрос
   s=cells(rows.count,1).end(xlup).row
    Range("A8:E" & s).Select
    Selection.Copy
    Sheets("План Факт по заявке").Select
    Range("A6").Select
    ActiveSheet.Paste
    Sheets("Подтверждение заявок для УПТК").Select
    Range("F8:F" & s).Select
    Range("F60").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("План Факт по заявке").Select
    Range("G6").Select
    ActiveSheet.Paste
    Sheets("Подтверждение заявок для УПТК").Select
    Range("I8:I" & s).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("План Факт по заявке").Select
    Range("J6").Select
    ActiveSheet.Paste
End Sub
[/vba]
Таким образом получим, что копироваться будут не только данные до 60 строки, а все те, что есть (больше или меньше - роли не играет)
чтобы корректно его добавить в существующий макрос, добавьте к нему в начало строку [vba]
Код
Sheets("Исходный лист").select
[/vba] и добавьте перед последней строкой (Где у Вас Msgbox)

P.S. предложил максимально простой вариант для реализации без каких либо особых навыков, S в этом коде вычисляет последнюю занятую строку в 1 столбце, соответственно, если у Вас несколько листов, то по аналогии, я думаю, уже сможете остальное сделать сами.

Автор - Szekerfehesvar
Дата добавления - 19.09.2016 в 15:48
lebensvoll Дата: Понедельник, 19.09.2016, 16:03 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
Szekerfehesvar, т.е. получается я практически верно записал макрос с помощью декодера (вроде)???
Единственное что вы дополнили мне код
Цитата
Таким образом получим, что копироваться будут не только данные до 60 строки, а все те, что есть (больше или меньше - роли не играет)

[vba]
Код
s=cells(rows.count,1).end(xlup).row
[/vba]
Ну а действующий мой код должен продолжить свою работу ((( его вы учли???
[vba]
Код
q = MsgBox("Вы уверены что хотите сохранить данные в журнал заявок???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий
'Код для сохранения данных в общий журнал реестра
    Dim shSheetf As Worksheet
    Dim shSheett As Worksheet
' Dim lStartSheet_("Подтверждение заявок для УПТК") As Long, lEndSheet_("Подтверждение заявок для УПТК") As Long
    Dim lLastRow As Long
    Dim i As Long
    'Даём листам имена "("Подтверждение заявок для УПТК")" и "shSheet_("Общий журнал заявок для УПТК")",
    'чтобы было удобнее писать код.
    Set shSheetf = Worksheets("Подтверждение заявок для УПТК")
    Set shSheett = Worksheets("Общий журнал заявок для УПТК")
    lStartSheet = 8
    lEndSheet = shSheetf.Cells(Rows.Count, 1).End(xlUp).Row
    'Указываем, с какой строки начать вставлять данные на второй лист.
    lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
    'Двигаем по первому листу по столбцу "A".
For i = lStartSheet To lEndSheet
        If Not shSheetf.Cells(i, 2).Value = Empty Then
            'Переносим данные на второй лист.
            shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value
            For X = 1 To 12
        shSheett.Cells(lLastRow, X + 1).Value = shSheetf.Cells(i, X).Value
        Next X
            'Изменяем переменную "lLastRow",
            'чтобы данные уже вставлять в следующую строку.
            lLastRow = lLastRow + 1
        End If
    Next i
            Range(Cells(8, 1), Cells(lEndSheet, 60)).ClearContents
    MsgBox "ДАННЫЕ ПЕРЕНЕСЕНЫ НА ЛИСТ ЖУРНАЛА ЗАЯВОК..."
[/vba]
Цитата
Посидев совместно с "операторами" пришли к тому что: А можно ли при нажатии данной кнопки чтоб не только переносились эти данные на другой лист в общий журнал. А также производилось частичное копирование данных также на другие листы (перед тем когда эти данные перенесутся в общий журнал)!?


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеSzekerfehesvar, т.е. получается я практически верно записал макрос с помощью декодера (вроде)???
Единственное что вы дополнили мне код
Цитата
Таким образом получим, что копироваться будут не только данные до 60 строки, а все те, что есть (больше или меньше - роли не играет)

[vba]
Код
s=cells(rows.count,1).end(xlup).row
[/vba]
Ну а действующий мой код должен продолжить свою работу ((( его вы учли???
[vba]
Код
q = MsgBox("Вы уверены что хотите сохранить данные в журнал заявок???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий
'Код для сохранения данных в общий журнал реестра
    Dim shSheetf As Worksheet
    Dim shSheett As Worksheet
' Dim lStartSheet_("Подтверждение заявок для УПТК") As Long, lEndSheet_("Подтверждение заявок для УПТК") As Long
    Dim lLastRow As Long
    Dim i As Long
    'Даём листам имена "("Подтверждение заявок для УПТК")" и "shSheet_("Общий журнал заявок для УПТК")",
    'чтобы было удобнее писать код.
    Set shSheetf = Worksheets("Подтверждение заявок для УПТК")
    Set shSheett = Worksheets("Общий журнал заявок для УПТК")
    lStartSheet = 8
    lEndSheet = shSheetf.Cells(Rows.Count, 1).End(xlUp).Row
    'Указываем, с какой строки начать вставлять данные на второй лист.
    lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
    'Двигаем по первому листу по столбцу "A".
For i = lStartSheet To lEndSheet
        If Not shSheetf.Cells(i, 2).Value = Empty Then
            'Переносим данные на второй лист.
            shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value
            For X = 1 To 12
        shSheett.Cells(lLastRow, X + 1).Value = shSheetf.Cells(i, X).Value
        Next X
            'Изменяем переменную "lLastRow",
            'чтобы данные уже вставлять в следующую строку.
            lLastRow = lLastRow + 1
        End If
    Next i
            Range(Cells(8, 1), Cells(lEndSheet, 60)).ClearContents
    MsgBox "ДАННЫЕ ПЕРЕНЕСЕНЫ НА ЛИСТ ЖУРНАЛА ЗАЯВОК..."
[/vba]
Цитата
Посидев совместно с "операторами" пришли к тому что: А можно ли при нажатии данной кнопки чтоб не только переносились эти данные на другой лист в общий журнал. А также производилось частичное копирование данных также на другие листы (перед тем когда эти данные перенесутся в общий журнал)!?

Автор - lebensvoll
Дата добавления - 19.09.2016 в 16:03
Manyasha Дата: Понедельник, 19.09.2016, 16:27 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 1590
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
lebensvoll, Szekerfehesvar, старайтесь не использовать Select и Activate. И код красивее выглядит, и макрос быстрее выполняется :)
производилось частичное копирование данных также на другие листы

[vba]
Код
Sub Макрос1()
    Dim sh1 As Worksheet, sh
    Dim s1 As Long, s2 As Long
' Макрос1 Макрос
    Set sh1 = Worksheets("Подтверждение заявок для УПТК")
    
    s1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
    'идем по листам с именами из Array
    For Each sh In Array("План Факт по заявке", "еще какой-то лист")
        'для листа с текущем именем
        With Worksheets(sh)
            'вычисляем последнюю строку на листе +1
            s2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            'копируем...
            .Range("A" & s2).Resize(s1, 5) = sh1.Range("A8:E" & s).Value
            .Range("G" & s2).Resize(s1) = sh1.Range("F8:F" & s).Value
            .Range("J" & s2).Resize(s1) = sh1.Range("I8:I" & s).Value
        End With
    Next sh
End Sub
[/vba]
Ну а действующий мой код должен продолжить свою работу

Вставьте вызов этого макроса или просто код (без "sub") в нужное место своего макроса переноса.


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеlebensvoll, Szekerfehesvar, старайтесь не использовать Select и Activate. И код красивее выглядит, и макрос быстрее выполняется :)
производилось частичное копирование данных также на другие листы

[vba]
Код
Sub Макрос1()
    Dim sh1 As Worksheet, sh
    Dim s1 As Long, s2 As Long
' Макрос1 Макрос
    Set sh1 = Worksheets("Подтверждение заявок для УПТК")
    
    s1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
    'идем по листам с именами из Array
    For Each sh In Array("План Факт по заявке", "еще какой-то лист")
        'для листа с текущем именем
        With Worksheets(sh)
            'вычисляем последнюю строку на листе +1
            s2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            'копируем...
            .Range("A" & s2).Resize(s1, 5) = sh1.Range("A8:E" & s).Value
            .Range("G" & s2).Resize(s1) = sh1.Range("F8:F" & s).Value
            .Range("J" & s2).Resize(s1) = sh1.Range("I8:I" & s).Value
        End With
    Next sh
End Sub
[/vba]
Ну а действующий мой код должен продолжить свою работу

Вставьте вызов этого макроса или просто код (без "sub") в нужное место своего макроса переноса.

Автор - Manyasha
Дата добавления - 19.09.2016 в 16:27
lebensvoll Дата: Понедельник, 19.09.2016, 16:37 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
Manyasha, я прошу меня простить но вопрос вот какой???
Цитата
'вычисляем последнюю строку на листе +1
s2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1

Данный код говорит что двигаясь по столбцу 1 вычисляем последнюю заполненную строку???
Правильно я понял???
Просто у меня на столбце "J" как раз таки есть та информацию которая мне не нужна для копирования ((((
[img][/img]
но есть одно успокоение что данная запись идет через пустую ячейку (просто я сомневаюсь а вдруг ее скопирует :( )


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеManyasha, я прошу меня простить но вопрос вот какой???
Цитата
'вычисляем последнюю строку на листе +1
s2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1

Данный код говорит что двигаясь по столбцу 1 вычисляем последнюю заполненную строку???
Правильно я понял???
Просто у меня на столбце "J" как раз таки есть та информацию которая мне не нужна для копирования ((((
[img][/img]
но есть одно успокоение что данная запись идет через пустую ячейку (просто я сомневаюсь а вдруг ее скопирует :( )

Автор - lebensvoll
Дата добавления - 19.09.2016 в 16:37
Szekerfehesvar Дата: Понедельник, 19.09.2016, 16:39 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 6 ±
Замечаний: 20% ±

Excel 2013
lebensvoll, если Вы вставите мой код в свой код перед последней строкой с учетом добавки строки "Sheets", то сначала отработает обычный макрос, а затем новая его часть.
Manyasha, специально старался оставить максимум от макрокодера, чтобы затем можно было по аналогии сделать для остальных листов, не сильно вникая в кодовую часть, естественно, что Ваш вариант выглядит куда более читаемо и отработает быстрее, но, возможно, будет более сложным для понимания человеком без практики
 
Ответить
Сообщениеlebensvoll, если Вы вставите мой код в свой код перед последней строкой с учетом добавки строки "Sheets", то сначала отработает обычный макрос, а затем новая его часть.
Manyasha, специально старался оставить максимум от макрокодера, чтобы затем можно было по аналогии сделать для остальных листов, не сильно вникая в кодовую часть, естественно, что Ваш вариант выглядит куда более читаемо и отработает быстрее, но, возможно, будет более сложным для понимания человеком без практики

Автор - Szekerfehesvar
Дата добавления - 19.09.2016 в 16:39
Szekerfehesvar Дата: Понедельник, 19.09.2016, 16:41 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 6 ±
Замечаний: 20% ±

Excel 2013
lebensvoll,
Manyasha, я прошу меня простить но вопрос вот какой???
Цитата
'вычисляем последнюю строку на листе +1
s2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1

данная формула вычислит последнюю строку в указанном столбце - там где стоит цифра 1 после count- это значит 1 столбец ("А")
 
Ответить
Сообщениеlebensvoll,
Manyasha, я прошу меня простить но вопрос вот какой???
Цитата
'вычисляем последнюю строку на листе +1
s2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1

данная формула вычислит последнюю строку в указанном столбце - там где стоит цифра 1 после count- это значит 1 столбец ("А")

Автор - Szekerfehesvar
Дата добавления - 19.09.2016 в 16:41
lebensvoll Дата: Понедельник, 19.09.2016, 16:43 | Сообщение № 8
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
Manyasha, и мой код будет выглядеть вот так вот???
[vba]
Код
q = MsgBox("Вы уверены что хотите сохранить данные в журнал заявок???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий
    Dim sh1 As Worksheet, sh 'код копирования нужных данных в нужные нам листы
    Dim s1 As Long, s2 As Long
    Set sh1 = Worksheets("Подтверждение заявок для УПТК")
    
    s1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
    'идем по листам с именами из Array
    For Each sh In Array("План Факт по заявке", "еще какой-то лист")
        'для листа с текущем именем
        With Worksheets(sh)
            'вычисляем последнюю строку на листе +1
            s2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            'копируем...
            .Range("A" & s2).Resize(s1, 5) = sh1.Range("A8:E" & s).Value
            .Range("G" & s2).Resize(s1) = sh1.Range("F8:F" & s).Value
            .Range("J" & s2).Resize(s1) = sh1.Range("I8:I" & s).Value
        End With
    Next sh
'Код для сохранения данных в общий журнал реестра
    Dim shSheetf As Worksheet
    Dim shSheett As Worksheet
' Dim lStartSheet_("Подтверждение заявок для УПТК") As Long, lEndSheet_("Подтверждение заявок для УПТК") As Long
    Dim lLastRow As Long
    Dim i As Long
    'Даём листам имена "("Подтверждение заявок для УПТК")" и "shSheet_("Общий журнал заявок для УПТК")",
    'чтобы было удобнее писать код.
    Set shSheetf = Worksheets("Подтверждение заявок для УПТК")
    Set shSheett = Worksheets("Общий журнал заявок для УПТК")
    lStartSheet = 8
    lEndSheet = shSheetf.Cells(Rows.Count, 1).End(xlUp).Row
    'Указываем, с какой строки начать вставлять данные на второй лист.
    lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
    'Двигаем по первому листу по столбцу "A".
For i = lStartSheet To lEndSheet
        If Not shSheetf.Cells(i, 2).Value = Empty Then
            'Переносим данные на второй лист.
            shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value
            For X = 1 To 12
        shSheett.Cells(lLastRow, X + 1).Value = shSheetf.Cells(i, X).Value
        Next X
            'Изменяем переменную "lLastRow",
            'чтобы данные уже вставлять в следующую строку.
            lLastRow = lLastRow + 1
        End If
    Next i
            Range(Cells(8, 1), Cells(lEndSheet, 60)).ClearContents
    MsgBox "ДАННЫЕ ПЕРЕНЕСЕНЫ НА ЛИСТ ЖУРНАЛА ЗАЯВОК..."

End Sub
[/vba]
ВЕРНО Я ВСЕ СДЕЛАЛ!? меня смущает вот именно вот это???
Цитата
Next sh


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеManyasha, и мой код будет выглядеть вот так вот???
[vba]
Код
q = MsgBox("Вы уверены что хотите сохранить данные в журнал заявок???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий
    Dim sh1 As Worksheet, sh 'код копирования нужных данных в нужные нам листы
    Dim s1 As Long, s2 As Long
    Set sh1 = Worksheets("Подтверждение заявок для УПТК")
    
    s1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
    'идем по листам с именами из Array
    For Each sh In Array("План Факт по заявке", "еще какой-то лист")
        'для листа с текущем именем
        With Worksheets(sh)
            'вычисляем последнюю строку на листе +1
            s2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            'копируем...
            .Range("A" & s2).Resize(s1, 5) = sh1.Range("A8:E" & s).Value
            .Range("G" & s2).Resize(s1) = sh1.Range("F8:F" & s).Value
            .Range("J" & s2).Resize(s1) = sh1.Range("I8:I" & s).Value
        End With
    Next sh
'Код для сохранения данных в общий журнал реестра
    Dim shSheetf As Worksheet
    Dim shSheett As Worksheet
' Dim lStartSheet_("Подтверждение заявок для УПТК") As Long, lEndSheet_("Подтверждение заявок для УПТК") As Long
    Dim lLastRow As Long
    Dim i As Long
    'Даём листам имена "("Подтверждение заявок для УПТК")" и "shSheet_("Общий журнал заявок для УПТК")",
    'чтобы было удобнее писать код.
    Set shSheetf = Worksheets("Подтверждение заявок для УПТК")
    Set shSheett = Worksheets("Общий журнал заявок для УПТК")
    lStartSheet = 8
    lEndSheet = shSheetf.Cells(Rows.Count, 1).End(xlUp).Row
    'Указываем, с какой строки начать вставлять данные на второй лист.
    lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
    'Двигаем по первому листу по столбцу "A".
For i = lStartSheet To lEndSheet
        If Not shSheetf.Cells(i, 2).Value = Empty Then
            'Переносим данные на второй лист.
            shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value
            For X = 1 To 12
        shSheett.Cells(lLastRow, X + 1).Value = shSheetf.Cells(i, X).Value
        Next X
            'Изменяем переменную "lLastRow",
            'чтобы данные уже вставлять в следующую строку.
            lLastRow = lLastRow + 1
        End If
    Next i
            Range(Cells(8, 1), Cells(lEndSheet, 60)).ClearContents
    MsgBox "ДАННЫЕ ПЕРЕНЕСЕНЫ НА ЛИСТ ЖУРНАЛА ЗАЯВОК..."

End Sub
[/vba]
ВЕРНО Я ВСЕ СДЕЛАЛ!? меня смущает вот именно вот это???
Цитата
Next sh

Автор - lebensvoll
Дата добавления - 19.09.2016 в 16:43
lebensvoll Дата: Понедельник, 19.09.2016, 16:46 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
Szekerfehesvar, согласен с вами что нужно понимать что пишешь.
НО КАК ПОКАЗЫВАЕТ ПРАКТИКА ОБЩЕНИЯ на данном форуме.
ВСЕ УТВЕРЖДАЮТ что нужно понимать и учиться как правильно делать :) а как не правильно всегда успеешь научиться :D . Я просто не могу их писать вообще ((( поэтому иной раз стараюсь через запись а потом с вашей помощью стараюсь его преобразовать в красоту, быстродействие и как правильно!!!
Все равно спасибо вам огромное


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеSzekerfehesvar, согласен с вами что нужно понимать что пишешь.
НО КАК ПОКАЗЫВАЕТ ПРАКТИКА ОБЩЕНИЯ на данном форуме.
ВСЕ УТВЕРЖДАЮТ что нужно понимать и учиться как правильно делать :) а как не правильно всегда успеешь научиться :D . Я просто не могу их писать вообще ((( поэтому иной раз стараюсь через запись а потом с вашей помощью стараюсь его преобразовать в красоту, быстродействие и как правильно!!!
Все равно спасибо вам огромное

Автор - lebensvoll
Дата добавления - 19.09.2016 в 16:46
Szekerfehesvar Дата: Понедельник, 19.09.2016, 16:58 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 6 ±
Замечаний: 20% ±

Excel 2013
lebensvoll, кстати, комментарий по поводу кода Маняши - он добавит нужные Вам столбцы на все листы Вашего файла (которые внесете в Array), но именно одни и те же столбцы, если Вам на каждый лист нужно будет добавлять разные столбцы или те же столбцы, но в другой последовательности, то стоит чуть изменить код (но это уже под конкретные условия). Маняшиным вариантом если сможете работать - было бы шикарно, если нет - тут уже то, что предложил я.
И да, добавили код Вы так, что должно будет все отработать корректно.

Вставку кода, кстати, можно реализовать вот так:
[vba]
Код
q = MsgBox("Вы уверены что хотите сохранить данные в журнал заявок???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий
'Код для сохранения данных в общий журнал реестра
    Dim shSheetf As Worksheet
    Dim shSheett As Worksheet
' Dim lStartSheet_("Подтверждение заявок для УПТК") As Long, lEndSheet_("Подтверждение заявок для УПТК") As Long
    Dim lLastRow As Long
    Dim i As Long
    'Даём листам имена "("Подтверждение заявок для УПТК")" и "shSheet_("Общий журнал заявок для УПТК")",
    'чтобы было удобнее писать код.
    Set shSheetf = Worksheets("Подтверждение заявок для УПТК")
    Set shSheett = Worksheets("Общий журнал заявок для УПТК")
    lStartSheet = 8
    lEndSheet = shSheetf.Cells(Rows.Count, 1).End(xlUp).Row
    'Указываем, с какой строки начать вставлять данные на второй лист.
    lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
    'Двигаем по первому листу по столбцу "A".
For i = lStartSheet To lEndSheet
        If Not shSheetf.Cells(i, 2).Value = Empty Then
            'Переносим данные на второй лист.
            shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value
            For X = 1 To 12
        shSheett.Cells(lLastRow, X + 1).Value = shSheetf.Cells(i, X).Value
        Next X
            'Изменяем переменную "lLastRow",
            'чтобы данные уже вставлять в следующую строку.
            lLastRow = lLastRow + 1
        End If
    Next i
            Range(Cells(8, 1), Cells(lEndSheet, 60)).ClearContents
   Call Макрос1
    MsgBox "ДАННЫЕ ПЕРЕНЕСЕНЫ НА ЛИСТ ЖУРНАЛА ЗАЯВОК..."
[/vba]
и после фразы End Sub добавляете уже Маняшин код целиком. В итоге получается Ваш исходный код остается практически без изменений, ну и в целом так бывает гораздо удобнее делать, чем вставлять весь код в уже существующий, нагромождая там полотнища из текста и теряясь в нем


Сообщение отредактировал Szekerfehesvar - Понедельник, 19.09.2016, 17:04
 
Ответить
Сообщениеlebensvoll, кстати, комментарий по поводу кода Маняши - он добавит нужные Вам столбцы на все листы Вашего файла (которые внесете в Array), но именно одни и те же столбцы, если Вам на каждый лист нужно будет добавлять разные столбцы или те же столбцы, но в другой последовательности, то стоит чуть изменить код (но это уже под конкретные условия). Маняшиным вариантом если сможете работать - было бы шикарно, если нет - тут уже то, что предложил я.
И да, добавили код Вы так, что должно будет все отработать корректно.

Вставку кода, кстати, можно реализовать вот так:
[vba]
Код
q = MsgBox("Вы уверены что хотите сохранить данные в журнал заявок???", vbOKCancel)
If q = vbCancel Then Exit Sub 'Сообщения для утверждения ваших действий
'Код для сохранения данных в общий журнал реестра
    Dim shSheetf As Worksheet
    Dim shSheett As Worksheet
' Dim lStartSheet_("Подтверждение заявок для УПТК") As Long, lEndSheet_("Подтверждение заявок для УПТК") As Long
    Dim lLastRow As Long
    Dim i As Long
    'Даём листам имена "("Подтверждение заявок для УПТК")" и "shSheet_("Общий журнал заявок для УПТК")",
    'чтобы было удобнее писать код.
    Set shSheetf = Worksheets("Подтверждение заявок для УПТК")
    Set shSheett = Worksheets("Общий журнал заявок для УПТК")
    lStartSheet = 8
    lEndSheet = shSheetf.Cells(Rows.Count, 1).End(xlUp).Row
    'Указываем, с какой строки начать вставлять данные на второй лист.
    lLastRow = shSheett.Cells(Rows.Count, 2).End(xlUp).Row + 1
    'Двигаем по первому листу по столбцу "A".
For i = lStartSheet To lEndSheet
        If Not shSheetf.Cells(i, 2).Value = Empty Then
            'Переносим данные на второй лист.
            shSheett.Cells(lLastRow, 2).Value = shSheetf.Cells(i, 1).Value
            For X = 1 To 12
        shSheett.Cells(lLastRow, X + 1).Value = shSheetf.Cells(i, X).Value
        Next X
            'Изменяем переменную "lLastRow",
            'чтобы данные уже вставлять в следующую строку.
            lLastRow = lLastRow + 1
        End If
    Next i
            Range(Cells(8, 1), Cells(lEndSheet, 60)).ClearContents
   Call Макрос1
    MsgBox "ДАННЫЕ ПЕРЕНЕСЕНЫ НА ЛИСТ ЖУРНАЛА ЗАЯВОК..."
[/vba]
и после фразы End Sub добавляете уже Маняшин код целиком. В итоге получается Ваш исходный код остается практически без изменений, ну и в целом так бывает гораздо удобнее делать, чем вставлять весь код в уже существующий, нагромождая там полотнища из текста и теряясь в нем

Автор - Szekerfehesvar
Дата добавления - 19.09.2016 в 16:58
lebensvoll Дата: Понедельник, 19.09.2016, 17:14 | Сообщение № 11
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
Manyasha, проблема возникла (((( код ругается вот на что???
[img][/img]


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеManyasha, проблема возникла (((( код ругается вот на что???
[img][/img]

Автор - lebensvoll
Дата добавления - 19.09.2016 в 17:14
_Boroda_ Дата: Понедельник, 19.09.2016, 17:19 | Сообщение № 12
Группа: Модераторы
Ранг: Экселист
Сообщений: 9381
Репутация: 3951 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
s1 вместо s
Или s вместо s1
Это Марина Вас на (не)внимательность проверяет, чтобы бездумно код не копировали, а смотрели в меру возможности.


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщениеs1 вместо s
Или s вместо s1
Это Марина Вас на (не)внимательность проверяет, чтобы бездумно код не копировали, а смотрели в меру возможности.

Автор - _Boroda_
Дата добавления - 19.09.2016 в 17:19
Manyasha Дата: Понедельник, 19.09.2016, 17:20 | Сообщение № 13
Группа: Модераторы
Ранг: Старожил
Сообщений: 1590
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
lebensvoll, потому что не знает, что такое s. Забыла поменять: либо s меняйте на s1, либо наоборот (см. выше)
[vba]
Код
s1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
[/vba]

Range(Cells(8, 1), Cells(lEndSheet, 60)).ClearContents
Call Макрос1

может поменять их местами, как думаете?)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеlebensvoll, потому что не знает, что такое s. Забыла поменять: либо s меняйте на s1, либо наоборот (см. выше)
[vba]
Код
s1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
[/vba]

Range(Cells(8, 1), Cells(lEndSheet, 60)).ClearContents
Call Макрос1

может поменять их местами, как думаете?)

Автор - Manyasha
Дата добавления - 19.09.2016 в 17:20
Szekerfehesvar Дата: Понедельник, 19.09.2016, 17:21 | Сообщение № 14
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 6 ±
Замечаний: 20% ±

Excel 2013
Маняша, возможно Вы правы))


Сообщение отредактировал Szekerfehesvar - Понедельник, 19.09.2016, 17:22
 
Ответить
СообщениеМаняша, возможно Вы правы))

Автор - Szekerfehesvar
Дата добавления - 19.09.2016 в 17:21
lebensvoll Дата: Понедельник, 19.09.2016, 17:31 | Сообщение № 15
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
Manyasha, так в коде уже есть это (((
[vba]
Код
s1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
[/vba]
я не пойму ((((( где именно менять .... Менял s1 на просто s тогда ругается на лист
[img][/img]

Цитата
может поменять их местами, как думаете?)

Да не все верно и перенес на лист как нужно и диапазон очистил после переноса
А вот с копированием все же еще никак ((((


Кто бы ты ни был, мир в твоих руках

Сообщение отредактировал lebensvoll - Понедельник, 19.09.2016, 17:38
 
Ответить
СообщениеManyasha, так в коде уже есть это (((
[vba]
Код
s1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
[/vba]
я не пойму ((((( где именно менять .... Менял s1 на просто s тогда ругается на лист
[img][/img]

Цитата
может поменять их местами, как думаете?)

Да не все верно и перенес на лист как нужно и диапазон очистил после переноса
А вот с копированием все же еще никак ((((

Автор - lebensvoll
Дата добавления - 19.09.2016 в 17:31
Manyasha Дата: Понедельник, 19.09.2016, 17:37 | Сообщение № 16
Группа: Модераторы
Ранг: Старожил
Сообщений: 1590
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
lebensvoll, я Вам даже комментарии написала:
Цитата
'идем по листам с именами из Array
For Each sh In Array("План Факт по заявке", "еще какой-то лист")

у Вас есть лист с именем "еще какой-то лист"?


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеlebensvoll, я Вам даже комментарии написала:
Цитата
'идем по листам с именами из Array
For Each sh In Array("План Факт по заявке", "еще какой-то лист")

у Вас есть лист с именем "еще какой-то лист"?

Автор - Manyasha
Дата добавления - 19.09.2016 в 17:37
lebensvoll Дата: Понедельник, 19.09.2016, 17:41 | Сообщение № 17
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
Manyasha, :'( НЕТ ((((((
Я вас понял???? сейчас исправлю.
А тогда сразу встречный вопрос а если у меня не все таблицы идентичны как на этих двух листах и на другие листы другие столбцы должны будут копироваться то я могу ваш код просто продублировать в продолжение с измененными диапазонами (ну и соответственно листами)???
Я так понимаю через
Цитата
End If
верно???


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеManyasha, :'( НЕТ ((((((
Я вас понял???? сейчас исправлю.
А тогда сразу встречный вопрос а если у меня не все таблицы идентичны как на этих двух листах и на другие листы другие столбцы должны будут копироваться то я могу ваш код просто продублировать в продолжение с измененными диапазонами (ну и соответственно листами)???
Я так понимаю через
Цитата
End If
верно???

Автор - lebensvoll
Дата добавления - 19.09.2016 в 17:41
Szekerfehesvar Дата: Понедельник, 19.09.2016, 17:45 | Сообщение № 18
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 6 ±
Замечаний: 20% ±

Excel 2013
lebensvoll, у Вас на каждый лист должно будет добавляться что то свое по диапазонам? то есть двух одинаковых в плане переноса данных листов не будет - верно?
 
Ответить
Сообщениеlebensvoll, у Вас на каждый лист должно будет добавляться что то свое по диапазонам? то есть двух одинаковых в плане переноса данных листов не будет - верно?

Автор - Szekerfehesvar
Дата добавления - 19.09.2016 в 17:45
lebensvoll Дата: Понедельник, 19.09.2016, 17:52 | Сообщение № 19
Группа: Проверенные
Ранг: Ветеран
Сообщений: 645
Репутация: 2 ±
Замечаний: 60% ±

Excel 2010
Manyasha, код сработал но с одним не понятным действием (((((( он почему то их скопировал несколько раз смотрите ((((
[img][/img]
Szekerfehesvar, Да вы верно меня поняли... В данном примере я дал приближенные таблицы. Если же конечно не возможно будет предположенным вариантом
Цитата
А тогда сразу встречный вопрос а если у меня не все таблицы идентичны как на этих двух листах и на другие листы другие столбцы должны будут копироваться то я могу ваш код просто продублировать в продолжение с измененными диапазонами (ну и соответственно листами)???
Я так понимаю через
Цитата
End If
верно???

Я конечно постараюсь все таблицы приблизить к этим ((( раз такое дело...


Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеManyasha, код сработал но с одним не понятным действием (((((( он почему то их скопировал несколько раз смотрите ((((
[img][/img]
Szekerfehesvar, Да вы верно меня поняли... В данном примере я дал приближенные таблицы. Если же конечно не возможно будет предположенным вариантом
Цитата
А тогда сразу встречный вопрос а если у меня не все таблицы идентичны как на этих двух листах и на другие листы другие столбцы должны будут копироваться то я могу ваш код просто продублировать в продолжение с измененными диапазонами (ну и соответственно листами)???
Я так понимаю через
Цитата
End If
верно???

Я конечно постараюсь все таблицы приблизить к этим ((( раз такое дело...

Автор - lebensvoll
Дата добавления - 19.09.2016 в 17:52
RAN Дата: Понедельник, 19.09.2016, 17:57 | Сообщение № 20
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4277
Репутация: 829 ±
Замечаний: 0% ±

2010
lebensvoll, 600 сообщений, а проку - пшик! >(


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщениеlebensvoll, 600 сообщений, а проку - пшик! >(

Автор - RAN
Дата добавления - 19.09.2016 в 17:57
Мир MS Excel » Вопросы и решения » Вопросы по VBA » дополнить код копирование данных на лист опред.столбцы (Макросы/Sub)
Страница 1 из 3123»
Поиск:

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