Добрый день многоуважаемые форумчане!!! Прошу вас помощи вновь помогите пожалуйста!!! Имеется таблица (оператор заполняет данную таблицу через 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
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 столбце, соответственно, если у Вас несколько листов, то по аналогии, я думаю, уже сможете остальное сделать сами.
Можно чуть изменить Ваш же код: [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
Сообщение отредактировал Szekerfehesvar - Понедельник, 19.09.2016, 15:53
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]
Цитата
Посидев совместно с "операторами" пришли к тому что: А можно ли при нажатии данной кнопки чтоб не только переносились эти данные на другой лист в общий журнал. А также производилось частичное копирование данных также на другие листы (перед тем когда эти данные перенесутся в общий журнал)!?
производилось частичное копирование данных также на другие листы
[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 Макрос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
Данный код говорит что двигаясь по столбцу 1 вычисляем последнюю заполненную строку??? Правильно я понял??? Просто у меня на столбце "J" как раз таки есть та информацию которая мне не нужна для копирования (((( [img][/img] но есть одно успокоение что данная запись идет через пустую ячейку (просто я сомневаюсь а вдруг ее скопирует )
Manyasha, я прошу меня простить но вопрос вот какой???
Данный код говорит что двигаясь по столбцу 1 вычисляем последнюю заполненную строку??? Правильно я понял??? Просто у меня на столбце "J" как раз таки есть та информацию которая мне не нужна для копирования (((( [img][/img] но есть одно успокоение что данная запись идет через пустую ячейку (просто я сомневаюсь а вдруг ее скопирует )lebensvoll
lebensvoll, если Вы вставите мой код в свой код перед последней строкой с учетом добавки строки "Sheets", то сначала отработает обычный макрос, а затем новая его часть. Manyasha, специально старался оставить максимум от макрокодера, чтобы затем можно было по аналогии сделать для остальных листов, не сильно вникая в кодовую часть, естественно, что Ваш вариант выглядит куда более читаемо и отработает быстрее, но, возможно, будет более сложным для понимания человеком без практики
lebensvoll, если Вы вставите мой код в свой код перед последней строкой с учетом добавки строки "Sheets", то сначала отработает обычный макрос, а затем новая его часть. Manyasha, специально старался оставить максимум от макрокодера, чтобы затем можно было по аналогии сделать для остальных листов, не сильно вникая в кодовую часть, естественно, что Ваш вариант выглядит куда более читаемо и отработает быстрее, но, возможно, будет более сложным для понимания человеком без практикиSzekerfehesvar
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] ВЕРНО Я ВСЕ СДЕЛАЛ!? меня смущает вот именно вот это???
Szekerfehesvar, согласен с вами что нужно понимать что пишешь. НО КАК ПОКАЗЫВАЕТ ПРАКТИКА ОБЩЕНИЯ на данном форуме. ВСЕ УТВЕРЖДАЮТ что нужно понимать и учиться как правильно делать а как не правильно всегда успеешь научиться . Я просто не могу их писать вообще ((( поэтому иной раз стараюсь через запись а потом с вашей помощью стараюсь его преобразовать в красоту, быстродействие и как правильно!!! Все равно спасибо вам огромное
Szekerfehesvar, согласен с вами что нужно понимать что пишешь. НО КАК ПОКАЗЫВАЕТ ПРАКТИКА ОБЩЕНИЯ на данном форуме. ВСЕ УТВЕРЖДАЮТ что нужно понимать и учиться как правильно делать а как не правильно всегда успеешь научиться . Я просто не могу их писать вообще ((( поэтому иной раз стараюсь через запись а потом с вашей помощью стараюсь его преобразовать в красоту, быстродействие и как правильно!!! Все равно спасибо вам огромноеlebensvoll
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 добавляете уже Маняшин код целиком. В итоге получается Ваш исходный код остается практически без изменений, ну и в целом так бывает гораздо удобнее делать, чем вставлять весь код в уже существующий, нагромождая там полотнища из текста и теряясь в нем
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
Сообщение отредактировал Szekerfehesvar - Понедельник, 19.09.2016, 17:04
Manyasha, НЕТ (((((( Я вас понял???? сейчас исправлю. А тогда сразу встречный вопрос а если у меня не все таблицы идентичны как на этих двух листах и на другие листы другие столбцы должны будут копироваться то я могу ваш код просто продублировать в продолжение с измененными диапазонами (ну и соответственно листами)??? Я так понимаю через
Цитата
End If
верно???
Manyasha, НЕТ (((((( Я вас понял???? сейчас исправлю. А тогда сразу встречный вопрос а если у меня не все таблицы идентичны как на этих двух листах и на другие листы другие столбцы должны будут копироваться то я могу ваш код просто продублировать в продолжение с измененными диапазонами (ну и соответственно листами)??? Я так понимаю через
lebensvoll, у Вас на каждый лист должно будет добавляться что то свое по диапазонам? то есть двух одинаковых в плане переноса данных листов не будет - верно?
lebensvoll, у Вас на каждый лист должно будет добавляться что то свое по диапазонам? то есть двух одинаковых в плане переноса данных листов не будет - верно?Szekerfehesvar
Manyasha, код сработал но с одним не понятным действием (((((( он почему то их скопировал несколько раз смотрите (((( [img][/img] Szekerfehesvar, Да вы верно меня поняли... В данном примере я дал приближенные таблицы. Если же конечно не возможно будет предположенным вариантом
Цитата
А тогда сразу встречный вопрос а если у меня не все таблицы идентичны как на этих двух листах и на другие листы другие столбцы должны будут копироваться то я могу ваш код просто продублировать в продолжение с измененными диапазонами (ну и соответственно листами)??? Я так понимаю через Цитата End If верно???
Я конечно постараюсь все таблицы приблизить к этим ((( раз такое дело...
Manyasha, код сработал но с одним не понятным действием (((((( он почему то их скопировал несколько раз смотрите (((( [img][/img] Szekerfehesvar, Да вы верно меня поняли... В данном примере я дал приближенные таблицы. Если же конечно не возможно будет предположенным вариантом
Цитата
А тогда сразу встречный вопрос а если у меня не все таблицы идентичны как на этих двух листах и на другие листы другие столбцы должны будут копироваться то я могу ваш код просто продублировать в продолжение с измененными диапазонами (ну и соответственно листами)??? Я так понимаю через Цитата End If верно???
Я конечно постараюсь все таблицы приблизить к этим ((( раз такое дело...lebensvoll
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
помогите пожалуйста!!!
а также боюсь не верно этот код внести в существующий).
. Я просто не могу их писать вообще ((( поэтому иной раз стараюсь через запись а потом с вашей помощью стараюсь его преобразовать в красоту, быстродействие и как правильно!!!
