Generate Multiple excel file from multiple line in excel - vba

Question

I am trying to generate multiple Excel file from a list in excel. Below are the code i tried but got runtime error 70.
The excel i use are (which can be download here: https://drive.google.com/folderview?id=0B7u1K6cUEOzeWURZWWd3NjQ4R0k&usp=sharing)
1) BasicInvoice.xlsx
2) 2011.xlsx
Private Sub CommandButton1_Click()
Dim Name As String
Dim invoicenumber As Long
Dim r As Long
Dim path As String
Dim myfilename As String
lastrow = Sheets("1").Range("A" & Rows.Count).End(xlUp).Row
r = 2
For r = 2 To lastrow
Date = Sheets("1").Cells(r, 1).Value
invoicenumber = Sheets("1").Cells(r, 2).Value
Name = Sheets("1").Cells(r, 3).Value
Description = Sheets("1").Cells(r, 4).Value
Amount = Sheets("1").Cells(r, 5).Value
Workbooks.Open ("BasicInvoice.xlsx")
ActiveWorkbook.Sheets("BasicInvoice").Activate
ActiveWorkbook.Sheets("BasicInvoice").Range("E9").Value = Date
ActiveWorkbook.Sheets("BasicInvoice").Range("E10").Value = invoicenumber
ActiveWorkbook.Sheets("BasicInvoice").Range("B9").Value = Name
ActiveWorkbook.Sheets("BasicInvoice").Range("B16").Value = Description
ActiveWorkbook.Sheets("BasicInvoice").Range("E16").Value = Amount
path = "C:\invoices\"
ActiveWorkbook.SaveCopyAs Filename:=path & invoicenumber & ".xlsx"
myfilename = ActiveWorkbook.FullName
Application.DisplayAlerts = True
ActiveWorkbook.PrintOut copies:=1
ActiveWorkbook.Close SaveChanges:=False
nextrow:
Next r
End Sub

Answer 1

RunTime Error 70 indicates that you're unable to write to something write protected. What line are you getting the error on?
Check to make sure that C:/Invoices folder actually exists on your hard drive.
Below is a tidy up of your code while I'm here.
Private Sub CommandButton1_Click()
Dim wbInv As Workbook, wsInv As Worksheet
Dim wbSrc As Workbook, wsSrc As Worksheet
Dim lastrow As Long, r As Long
Dim path As String
Set wbSrc = ThisWorkbook
Set wsSrc = wbSrc.Sheets("1")
Set wbInv = Workbooks.Open("BasicInvoice.xlsx")
Set wsInv = wbInv.Sheets("BasicInvoice")
path = "C:\invoices\"
lastrow = wsSrc.Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For r = 2 To lastrow
With wsInv
.Range("E9").Value = wsSrc.Cells(r, 1).Value
.Range("E10").Value = wsSrc.Cells(r, 2).Value
.Range("B9").Value = wsSrc.Cells(r, 3).Value
.Range("B16").Value = wsSrc.Cells(r, 4).Value
.Range("E16").Value = wsSrc.Cells(r, 6).Value
End With
With wbInv
.SaveCopyAs Filename:=path & wsInv.Range("E10").Value & ".xlsx"
.PrintOut copies:=1
End With
Next r
wbInv.Close SaveChanges = False
Application.ScreenUpdating = True
End Sub