tonyaod
05-23-2011, 02:24 PM
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 ???
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 ???