Copy/Paste
 

Hi

I have been running this code to split the sheet
(Crystal_Table into seperate suppliers.

What i would like to do is set it up so i could copy
direct from the Original sheet (Crystal_Table) to the file
outfile(File_Name) instead of to a new sheet.

The sheet on the new file is called Data?

I know the how to copy the data but i do not know where to
put the line of code so the code still works properly.

Any help is appreciated.

Sub CopyInvoices()
Dim sCriteria As String
Dim sOriginal As String
Dim sNew As String
Dim i As Long
Dim File_Name As String

File_Name = ActiveWorkbook.Worksheets("Menu").Cells.Range
("D9").Value

Set outfile = Workbooks.Open(File_Name)
With ActiveWorkbook
Application.ScreenUpdating = False
Worksheets("Crystal_Table").Activate

With .ActiveSheet
..Rows(1).Insert
..Range("T1").Value = "Test"
sOriginal = .Name
End With

For i = 3 To .ActiveSheet.Cells(Rows.Count, "H").End
(xlUp).Row
sCriteria = .ActiveSheet.Cells(i, "H").Value
If sCriteria < "" Then
If sCriteria < .ActiveSheet.Cells(i - 1, "H").Value Then
..Worksheets.Add After:=.Worksheets(.Worksheets.Count)
..ActiveSheet.Name = sCriteria
sNew = .ActiveSheet.Name
..Worksheets(sOriginal).Activate
With .ActiveSheet
..Columns("H:H").AutoFilter Field:=1, Criteria1:=sCriteria
..Cells.SpecialCells(xlCellTypeVisible).Copy
End With
With .Worksheets(sNew)
..Paste
..Rows(1).EntireRow.Delete
..Columns("W:AQ").EntireColumn.Delete
..Columns("T:T").EntireColumn.Delete
..Columns("O:R").EntireColumn.Delete
..Columns("M:M").EntireColumn.Delete
..Columns("K:K").EntireColumn.Delete
..Columns("I:I").EntireColumn.Delete
..Columns("G:G").EntireColumn.Delete
..Columns("A:E").EntireColumn.Delete
..Columns("A:H").AutoFit

End With
End If
End If
Next i

..Worksheets(sOriginal).Rows(1).EntireRow.Delete

End With

Application.ScreenUpdating = True
Application.CutCopyMode = False
Workbooks("Remittance Module.xls").Activate

End Sub