Sub Zakaz()
Dim i As Integer, iStart As Integer, iFinish As Integer, Cols As Integer
Dim NewSheet As Worksheet, OldSheet As Worksheet, j As Integer, s As String
iStart = 1
Set OldSheet = ActiveSheet
iFinish = OldSheet.UsedRange.Rows.Count - iStart - 1
If iFinish < iStart Then
MsgBox "Нет данных для просмотра"
Else
Cols = OldSheet.UsedRange.Columns.Count
'1) Проверяем сумму, заказанного товара в колонке 9
'Если она = 0, то заказ не сделан - сохранять нечего!
'при этом считаем, что отрицательных значений здесь не может быть
If Application.WorksheetFunction.Sum( _
OldSheet.Range(OldSheet.Cells(iStart, Cols), _
OldSheet.Cells(iFinish, Cols))) > 0 Then
'Добавляем новый лист - для сбора результата
Set NewSheet = ActiveWorkbook.Worksheets.Add(OldSheet)
'печатаем на этом листе строку заголовка
NewSheet.Cells(1,1).Value = "CODE"
NewSheet.Cells(1,2).Value = "NAME"
NewSheet.Cells(1,3).Value = "AMOUNT"
'счетчик строк на новом листе
j = 1
For i = iStart + 1 To iFinish
'проверка наличия записи в колонке 9
s = OldSheet.Cells(i, 9).Value
If IsNumeric(s) Then
'да указано число - записываем строку на новый лист
'перход на следующую свободную строку листа-результата
j = j + 1
PrintRow OldSheet, NewSheet, i, j
'Else
'иначе, считаем, что заказа нет - 0
End If
Next i
'запись в формате dbf
NewSheet.SaveAs "d:\Zakaz.dbf", xlDBF4
'запись в формате txt
'NewSheet.SaveAs "d:\Zakaz.txt", xlTextWindows
Else
MsgBox "Нет заказанного товара!", vbOKOnly + vbInformation, "Сообщение"
End If
End If
End Sub
Function PrintRow(FromSh As Worksheet, Sh As Worksheet, iRow As Integer, jRow As Integer)
'Функция будет переносить строку iRow из активного листа в строку jRow листа Sh
Sh.Cells(jRow, 1).Value = FromSh.Cells(iRow, 2).Value
Sh.Cells(jRow, 2).Value = FromSh.Cells(iRow, 4).Value
Sh.Cells(jRow, 3).Value = FromSh.Cells(iRow, 9).Value
End Function
P.S.
Открываем книгу, в которой будет кнопка, далее в меню Сервис - Настройка, в открывшемся окошке на вкладке Панели инструментов выбираем Элементы управления. Закрываем окошко.
Должна появиться новая панелька с различными элементами управления - выбираем Кнопку(указатель мыши изменится на крест) и в нужном месте листа рисуем кнопку
Щелкаем правой кнопкой мыши на кнопке выбираем команду Объект CommfndButton - Edit и изменяем надпись на кнопке
Снова щелкаем правой кнопкой мыши на кнопке выбираем команду Исходный текст - будет открыт редактор Visual Basic, в котором нужно будет написать макрос-обработчик нажатия кнопки, например:
Private Sub CommandButton1_Click()
Workbooks.Open("d:\Path\book.xls")
Run "book.xls!nn"
End Sub
Естественно, должен существовать файл d:\Path\book.xls и в нем должен быть макрос nn()
Возвращаемся в книгу и на панели элементов управления выключаем режим конструктора - самая первая кнопка на панели.
Нажимаем на созданную кнопку и проверяем результат
