Здравствуйте. Уважаемы форумчане требуется ваша помощь, ибо сам я в этом не особо разбираюсь. Имеется макрос, который копирует строки из листа 1 на лист 2 при нажатии кнопки "Добавить", если в столбце А стоит 1, пустые пропускает. Теперь вопросы: -можно ли поменять значение единицы, на диапазон, например от 1 до 1000 или на значение ячейки(пустая или не пустая)? То как, а то что то у меня ни как не получается. -если первая задача решаема, то возможен ли перенос значений из столбца А, на листе 1, в столбец кол-во на листе 2? Файл во вложении.
Здравствуйте. Уважаемы форумчане требуется ваша помощь, ибо сам я в этом не особо разбираюсь. Имеется макрос, который копирует строки из листа 1 на лист 2 при нажатии кнопки "Добавить", если в столбце А стоит 1, пустые пропускает. Теперь вопросы: -можно ли поменять значение единицы, на диапазон, например от 1 до 1000 или на значение ячейки(пустая или не пустая)? То как, а то что то у меня ни как не получается. -если первая задача решаема, то возможен ли перенос значений из столбца А, на листе 1, в столбец кол-во на листе 2? Файл во вложении.Kraga
Sub toCSV() Dim wsh As Worksheet, wsh1 As Worksheet, wsh2 As Worksheet Dim rng1, rng2 As Range, rRow& With Application: .ScreenUpdating = 0: .EnableEvents = 0: End With On Error GoTo err Set wsh = ActiveSheet Set wsh1 = Sheets("IRR"): Set wsh2 = Sheets("CSV") Set rng1 = wsh1.[A:A].SpecialCells(xlCellTypeConstants, 1) Set rng2 = Intersect(wsh1.[O:R], rng1.EntireRow) With wsh2 rRow = Application.CountA(.[B:B]) rng2.Copy .[B1].Offset(rRow) rng1.Copy .[D1].Offset(rRow) rRow = Application.CountA(.[B:B])-1 .[A2:A3].AutoFill .[A2].Resize(rRow), 0 .[F2:I3].AutoFill .[F2:I3].Resize(rRow), 0 .[B2:E2].AutoFill .[B2:E2].Resize(rRow), 3 End With Application.CutCopyMode = 0: wsh.Activate Set wsh = Nothing: Set wsh1 = Nothing: Set wsh2 = Nothing err: With Application: .ScreenUpdating = 1: .EnableEvents = 1: End With End Sub
[/vba]
замените код в module2 на[vba]
Код
Sub toCSV() Dim wsh As Worksheet, wsh1 As Worksheet, wsh2 As Worksheet Dim rng1, rng2 As Range, rRow& With Application: .ScreenUpdating = 0: .EnableEvents = 0: End With On Error GoTo err Set wsh = ActiveSheet Set wsh1 = Sheets("IRR"): Set wsh2 = Sheets("CSV") Set rng1 = wsh1.[A:A].SpecialCells(xlCellTypeConstants, 1) Set rng2 = Intersect(wsh1.[O:R], rng1.EntireRow) With wsh2 rRow = Application.CountA(.[B:B]) rng2.Copy .[B1].Offset(rRow) rng1.Copy .[D1].Offset(rRow) rRow = Application.CountA(.[B:B])-1 .[A2:A3].AutoFill .[A2].Resize(rRow), 0 .[F2:I3].AutoFill .[F2:I3].Resize(rRow), 0 .[B2:E2].AutoFill .[B2:E2].Resize(rRow), 3 End With Application.CutCopyMode = 0: wsh.Activate Set wsh = Nothing: Set wsh1 = Nothing: Set wsh2 = Nothing err: With Application: .ScreenUpdating = 1: .EnableEvents = 1: End With End Sub