Добрый день, знатоки VBA. Мне нужна ваша помощь по написанию корректного макроса. Цель следующая: из активной книги в листе MyForm взять заполненные данные из диапазона вставить в другую книгу но уже как таблицу, затем сохранить и стереть данные из формы для заполнения(в некоторых ячейках есть формулы их нужно оставить). Ниже прилагаю макрос который я подсмотрел в видеоуроке и немного подшаманил. Я новичек в написании макросов так что прошу отнестись с пониманием)))
Заранее спасибо
P.S. в скрипте, возможно, много ненужных вещей. Поэтому прошу помочь с оформлением. прилагаю саму книгу с формой для заполнения а на листе TAble таблица в которую должны вписываться данные но в другой книге
Заранее спасибо
P.S. в скрипте, возможно, много ненужных вещей. Поэтому прошу помочь с оформлением. прилагаю саму книгу с формой для заполнения а на листе TAble таблица в которую должны вписываться данные но в другой книге
| Код |
|---|
Sub AddDATA()
Dim KNIGA As String
Dim ITK, IOK As String
KNIGA = "C:\Users\adilet.yessaliyev\Desktop\DATABASE.XLSX"
ITK = ThisWorkbook.Name
IOK = Dir(KNIGA)
GetObject (KNIGA)
Dim WSDATA As Worksheet
Set WSDATA = Workbooks(IOK).Worksheets(DATASHEET)
Dim nextRow As Long
nextRow = Workbooks(IOK).Worksheets(DATASHEET).Cells(WSDATA.Rows.Count, 3).End(xlUp).Offset(1, 0).Row
Dim rConstants As Range
With Workbooks(ITK).Worksheets(MyDataList)
If .Range("b4").Value = "" And .Range("C4").Value = "" Then
nextRow = nextRow - 1
End If
Workbooks(IOK).Worksheets(MyForm).Range("DATE").Copy
Workbooks(ITK).Worksheets(MyDataList).Cells(nextRow, 3).PasteSpecial Paste:=xlPasteValues
Workbooks(ITK).Worksheets(MyDataList).Cells(nextRow, 4).Value = Workbooks(ITK).Worksheets(MyForm).Range("REGION").Value
Workbooks(ITK).Worksheets(MyDataList).Cells(nextRow, 5).Value = Workbooks(IOK).Worksheets(MyForm).Range("RESPONSIBLE").Value
Workbooks(ITK).Worksheets(MyDataList).Cells(nextRow, 6).Value = Workbooks(IOK).Worksheets(MyForm).Range("RESPONSIBLE_NAME").Value
Workbooks(ITK).Worksheets(MyDataList).Cells(nextRow, 7).Value = Workbooks(IOK).Worksheets(MyForm).Range("RESPONSIBLE_DIVISION").Value
Workbooks(ITK).Worksheets(MyDataList).Cells(nextRow, 8).Value = Workbooks(IOK).Worksheets(MyForm).Range("DIVISION_NAME").Value
Workbooks(ITK).Worksheets(MyDataList).Cells(nextRow, 9).Value = Workbooks(IOK).Worksheets(MyForm).Range("FROM").Value
Workbooks(ITK).Worksheets(MyDataList).Cells(nextRow, 10).Value = Workbooks(IOK).Worksheets(MyForm).Range("FROM_NAME").Value
Workbooks(ITK).Worksheets(MyDataList).Cells(nextRow, 11).Value = Workbooks(IOK).Worksheets(MyForm).Range("TO").Value
Workbooks(ITK).Worksheets(MyDataList).Cells(nextRow, 12).Value = Workbooks(IOK).Worksheets(MyForm).Range("TO_NAME").Value
Workbooks(ITK).Worksheets(MyDataList).Cells(nextRow, 13).Value = Workbooks(IOK).Worksheets(MyForm).Range("CODE_TYPE").Value
Workbooks(ITK).Worksheets(MyDataList).Cells(nextRow, 14).Value = Workbooks(IOK).Worksheets(MyForm).Range("CODE").Value
Workbooks(ITK).Worksheets(MyDataList).Cells(nextRow, 15).Value = Workbooks(IOK).Worksheets(MyForm).Range("PRODUCT_NAME").Value
Workbooks(ITK).Worksheets(MyDataList).Cells(nextRow, 16).Value = Workbooks(IOK).Worksheets(MyForm).Range("RECIEVER").Value
Workbooks(ITK).Worksheets(MyDataList).Cells(nextRow, 17).Value = Workbooks(IOK).Worksheets(MyForm).Range("RECIEVER_NAME").Value
Workbooks(ITK).Worksheets(MyDataList).Range("B4").Formula = "=If(ISBLANK(C4), """", COUNTA($C$4:C4))"
If nextRow > 4 Then
Workbooks(ITK).Worksheets(MyDataList).Activate
Workbooks(ITK).Worksheets(MyDataList).Range("B4").Select
Selection.AutoFill Destination:=Range("B4:B" & nextRow)
Range("B4:B" & nextRow).Select
End If
Workbooks(IOK).Worksheets(MyForm).Activate
Set rConstants = Workbooks(IOK).Worksheets(MyForm).Range("ENTRIES").SpecialCells(xlCellTypeConstants)
rConstants.ClearContents
ActiveWindow.DisplayFormulas = False
End With
Workbooks(IOK).Close (True)
End Sub
|
Изменено: - 04.12.2018 13:39:00
