Я пытаюсь скопировать диапазон (от A1 до E26) данных из вывода Active-листа в новую книгу Excel и сохранить новую книгу со значением Active-sheet в D3 и E3.
Здесь это VBA у меня до сих пор: заранее спасибо.
Sub save_Bill()
Dim rng As Range
Dim i As Long
Dim a As Long
Dim rng_dest As Range
Dim path As String
Application.ScreenUpdating = False
'Check if invoice # is found on sheet "sold" path = "E:\1b\" i = 1
Do Until Sheets("sold").Range("A" & i).Value = ""
If Sheets("sold").Range("A" & i).Value = Sheets("Invoice").Range("E2").Value Then
'Ask overwrite invoice #?
If MsgBox("Overwrite sold?", vbYesNo) = vbNo Then
Exit Sub
Else
Exit Do
End If
End If
i = i + 1
Loop
i = 1
Set rng_dest = Sheets("sold").Range("C:F")
'Delete rows if invoice # is found
Do Until Sheets("sold").Range("A" & i).Value = ""
If Sheets("sold").Range("A" & i).Value = Sheets("Invoice").Range("E2").Value Then
Sheets("sold").Range("A" & i).EntireRow.Delete
i = 1
End If
i = i + 1
Loop
' Find first empty row in columns C:F on sheet sold
Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
i = i + 1
Loop
'Copy range B25:F26 on sheet Invoice
Set rng = Sheets("Invoice").Range("B26:E26")
' Copy rows containing values to sheet sold
For a = 1 To rng.Rows.Count
If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
rng_dest.Rows(i).Value = rng.Rows(a).Value
'Copy Invoice number
Sheets("sold").Range("A" & i).Value = Sheets("Invoice").Range("E2").Value
'Copy Date
Sheets("sold").Range("B" & i).Value = Sheets("Invoice").Range("E3").Value
i = i + 1
End If
Next a
MsgBox ("Invoice saved!")
Application.ScreenUpdating = True
'here's am trying to set a range (A1:E26) to save in new created workbook
Set wb = Workbooks.Add
ThisWorkbook.Activate
ActiveSheet.Copy Before:=wb.Sheets(1)
wb.Activate
'make a new directory
If Dir(path) <> "" Then
Exit Sub
End If
MkDir path
wb.SaveAs path & Range("D2").Value & Range("E2").Value & ".xlsx"
wb.Close path & Range("D2").Value & Range("E2").Value & ".xlsx"
End Sub