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
|