Help with VBA that copies data & creates new file

[tonyaod]

I am struggling with code that copies cells from a sheet onto a new sheet then takes that data and creates a new file with the data in.

I have read it & read it & according to my books it looks fine - please can anyone help.

Its excel 2010



Sub Extract_Items()

Dim xCell As Variant, ToCell As Variant, Sheet1 As Variant, Sheet2 As Variant
Dim Row, Column As Integer

'If Check_Duplications() Then
ActiveWorkbook.Save


Set Sheet1 = Sheets("Sheet1")
Set Sheet2 = Sheets("Winelst2")
Set ToCell = Sheet2.Range("B2")
Row = 0
Column = 0
Sheet2.Range("A1:Z1000").Clear


'Set up column headings
ToCell.Offset(-1, -1).Value = "!INVITEM"
ToCell.Offset(-1, 0).Value = "Tonya"
ToCell.Offset(-1, 1).Value = "INVITEMTYPE"
ToCell.Offset(-1, 2).Value = "DESC"
ToCell.Offset(-1, 3).Value = "ACCNT"
ToCell.Offset(-1, 4).Value = "PRICE"
ToCell.Offset(-1, 5).Value = "TAXABLE"
ToCell.Offset(-1, 6).Value = "VATCODE"

For Each xCell In Sheet1.Range("A1:A1000")
If Not xCell = "END" Then
If Not IsEmpty(xCell) And IsNumeric(xCell) Then
ToCell.Offset(Row, Column - 1).Value = "INVITEM"
ToCell.Offset(Row, Column).Value = xCell
ToCell.Offset(Row, Column + 1).Value = "PART"
ToCell.Offset(Row, Column + 2).Value = xCell.Offset(0, 1)
ToCell.Offset(Row, Column + 3).Value = "Sales"
ToCell.Offset(Row, Column + 4).Value = xCell.Offset(0, 11)
ToCell.Offset(Row, Column + 5).Value = "Y"
ToCell.Offset(Row, Column + 6).Value = xCell.Offset(0, 12)
Row = Row + 1
End If
End If
Next

On Error Resume Next
Sheet2.SaveAs Filename:="C:\Qbooksw\Winelst3.iif", FileFormat:=xlText, CreateBackup:=False
If Err.Number <> 0 And Err.Number <> 1004 Then
Beep
Call MsgBox("Error: " & Err.Number & ", " & Err.Description, vbOKOnly, _
"ERROR DURING SAVE OF .IIF FILE")
End If
On Error GoTo 0

'End If

End Sub


Can anyone help please ???

[tonyaod]

The code tests fine up to create new file !! Currently looking up help on saving a workbook as a new file :)

[tonyaod]

BTW the iff file is a quickbooks file