Добрый вечер, уважаемые форумчане. Написал свой первый код.И что то пошло не так. [vba]
Код
Sub DataEntryForm() Dim nextRow As Long nextRow = proekt.Cells(proekt.Rows.Count, 2).End(xlUp).Offset(1, 0).Row With proekt If .Range("A2").Value = "" And .Range("B2").Value = "" Then nextRow = nextRow - 1 End If proekt.Range("data1").Copy .Cells(nextRow, 2).PasteSpecial Paste:=xlPasteValues .Cells(nextRow, 3).Value = proekt.Range("client").Value .Cells(nextRow, 4).Value = proekt.Range("sotrudnik").Value .Cells(nextRow, 5).Value = proekt.Range("kolekcia").Value .Range("A2").Formula = "=IF(ISBLANK(B2), """", COUNTA($B$2:B2))" If nextRow > 2 Then Range("A2").Select Selection.AutoFill Destination:=Range("A2:A" & nextRow) Range("A2:A" & nextRow).Select End If .Range("diapason").ClearContents End With End Sub
[/vba] В чем моя ошибка? Что нужно скорректировать в коде? Спасибо.
Добрый вечер, уважаемые форумчане. Написал свой первый код.И что то пошло не так. [vba]
Код
Sub DataEntryForm() Dim nextRow As Long nextRow = proekt.Cells(proekt.Rows.Count, 2).End(xlUp).Offset(1, 0).Row With proekt If .Range("A2").Value = "" And .Range("B2").Value = "" Then nextRow = nextRow - 1 End If proekt.Range("data1").Copy .Cells(nextRow, 2).PasteSpecial Paste:=xlPasteValues .Cells(nextRow, 3).Value = proekt.Range("client").Value .Cells(nextRow, 4).Value = proekt.Range("sotrudnik").Value .Cells(nextRow, 5).Value = proekt.Range("kolekcia").Value .Range("A2").Formula = "=IF(ISBLANK(B2), """", COUNTA($B$2:B2))" If nextRow > 2 Then Range("A2").Select Selection.AutoFill Destination:=Range("A2:A" & nextRow) Range("A2:A" & nextRow).Select End If .Range("diapason").ClearContents End With End Sub
[/vba] В чем моя ошибка? Что нужно скорректировать в коде? Спасибо.miha_
Sub DataEntryForm() Dim nextRow As Long nextRow = proekt.Cells(proekt.Rows.Count, 2).End(xlUp).Offset(1, 0).Row With proekt If .Range("A2").Value = "" And .Range("B2").Value = "" Then nextRow = nextRow - 1 End If [Data1].Copy .Cells(nextRow, 2).PasteSpecial Paste:=xlPasteValues .Cells(nextRow, 3).Value = [client].Value .Cells(nextRow, 4).Value = [sotrudnik].Value .Cells(nextRow, 5).Value = [kolekcia].Value .Range("A2").Formula = "=IF(ISBLANK(B2), """", COUNTA($B$2:B2))" If nextRow > 2 Then 'Range("A2").AutoFill Destination:=Range("A2:A" & nextRow)' укажите родителя. End If [diapason].ClearContents End With End Sub
Sub DataEntryForm() Dim nextRow As Long nextRow = proekt.Cells(proekt.Rows.Count, 2).End(xlUp).Offset(1, 0).Row With proekt If .Range("A2").Value = "" And .Range("B2").Value = "" Then nextRow = nextRow - 1 End If [Data1].Copy .Cells(nextRow, 2).PasteSpecial Paste:=xlPasteValues .Cells(nextRow, 3).Value = [client].Value .Cells(nextRow, 4).Value = [sotrudnik].Value .Cells(nextRow, 5).Value = [kolekcia].Value .Range("A2").Formula = "=IF(ISBLANK(B2), """", COUNTA($B$2:B2))" If nextRow > 2 Then 'Range("A2").AutoFill Destination:=Range("A2:A" & nextRow)' укажите родителя. End If [diapason].ClearContents End With End Sub
должны быть на одном листе? я перенес все на один лист - работает. Только необходимо такое расположение таблицы и таблицы ввода как в примере. Как преобразовать код? Спасибо.
должны быть на одном листе? я перенес все на один лист - работает. Только необходимо такое расположение таблицы и таблицы ввода как в примере. Как преобразовать код? Спасибо.miha_
Сообщение отредактировал miha_ - Вторник, 15.08.2017, 23:36