Merge and Move Data??

[THE_RAMONES]

I have a program that grabs data from a particular folder and merges the
data.. Adds formulas, columns, etc..

However, I want to move the orginal workbooks to a different folder. So,
the user will be able to put active workbooks to merge and after the program
runs its empty again ready for the user to put additional workbooks.

Please let me know if this is possible. The code is below.. thanks in
advance for the help....

Private Sub Workbook_Open()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet
Dim bdFileName As String
Dim FullFileName As String

Application.DisplayAlerts = False
FullFileName = ActiveWorkbook.FullName
bdFileName = Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - 4)

ActiveWorkbook.SaveCopyAs FileName:="H:\My
Documents\COMPLETED_FILES_CMS\BACK_UP\" & _
"BACK_UP_" & bdFileName & Format(Now, "_YYYY_MM-DD_H-MM-SS") & _
".xls"




Application.DisplayAlerts = False
Sheets.Add
Sheets("UPLOAD_FILE").Delete
Application.EnableEvents = True
Application.ScreenUpdating = True
Path = "H:\My Documents\COMPLETED_FILES_CMS"
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName,
Password:="resolution")
For Each WS In Wkb.Worksheets
WS.Unprotect
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True


Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long

On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("UPLOAD_FILE").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "UPLOAD_FILE"
For Each sh In ThisWorkbook.Worksheets
If Left(sh.Name, 3) <> "She" Then
Last = LastRow(DestSh)
sh.Rows("1:350").Copy DestSh.Cells(Last + 1, "A")
End If
Next


DestSh.Cells.Sort Key1:=DestSh.Range("b2"),
Order1:=xlAscending, Header:=xlYes, _
Key2:=DestSh.Range("c2"), Order2:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
'DestSh.Cells(1).Select

Application.ScreenUpdating = True
Else
MsgBox "The sheet Master already exist"
End If

Application.EnableEvents = True
Application.ScreenUpdating = True

For Each sh In ThisWorkbook.Worksheets
If Left(sh.Name, 3) = "She" Then
sh.Delete
End If
Next sh




'Sheets("UPLOAD_FILE").Range("A1:AA35000").Copy
'Sheets("FILE SENT FROM CMS").Range("A982:AA35982").PasteSpecial


For Each sh In ThisWorkbook.Worksheets
If Left(sh.Name, 2) <> "UP" Then
sh.Delete
End If
Next sh

Sheets("UPLOAD_FILE").Columns("J:J").Insert
Sheets("UPLOAD_FILE").Columns("J:J").Insert
Sheets("UPLOAD_FILE").Columns("J:J").Insert

Sheets("UPLOAD_FILE").Range("J1").FormulaR1C1 = "FIRST NAME"
Sheets("UPLOAD_FILE").Range("K1").FormulaR1C1 = "LAST NAME"
Sheets("UPLOAD_FILE").Range("L1").FormulaR1C1 = "COMMENTS/MIDDLE INITIAL"

Sheets("UPLOAD_FILE").Range("AD1").FormulaR1C1 = "DEPT"
Sheets("UPLOAD_FILE").Range("AE1").FormulaR1C1 = "SOURCE"
Sheets("UPLOAD_FILE").Range("AF1").FormulaR1C1 = "LIS ELIGIBILITY LEVEL"
Sheets("UPLOAD_FILE").Range("AG1").FormulaR1C1 = "DATE RECEIVED"
Sheets("UPLOAD_FILE").Range("AH1").FormulaR1C1 = "RESOLUTION"
Sheets("UPLOAD_FILE").Range("AI1").FormulaR1C1 = "RESOLUTION DATE"
Sheets("UPLOAD_FILE").Range("AJ1").FormulaR1C1 = "AGING"


Dim iLastRow As Long
Dim sFormula As String

sFormula = "=LEFT(I2,IF(ISERROR(FIND("" "",I2,1)),LEN(I2),FIND(""
"",I2,1)-1))"
iLastRow = Cells(Rows.Count, "I").End(xlUp).Row
With Range("J2")
..Formula = sFormula
..AutoFill .Resize(iLastRow - 5)
End With

sFormula = "=TRIM(IF(ISERROR(FIND("" "",I2,1)),I2,MID(I2,FIND(""
"",I2,1)+1,IF(ISERROR(FIND("" "",I2,FIND("" "",I2,1)+2)),LEN(I2),FIND(""
"",I2,FIND("" "",I2,1)+2))-FIND("" "",I2,1))))"
iLastRow = Cells(Rows.Count, "I").End(xlUp).Row
With Range("k2")
..Formula = sFormula
..AutoFill .Resize(iLastRow - 5)
End With

sFormula = "=TRIM(RIGHT(I2,LEN(I2)-IF(ISERROR(FIND("" "",I2,FIND(""
"",I2,FIND("" "",I2,1)+2))),LEN(I2),FIND("" "",I2,FIND("" "",I2,FIND(""
"",I2,1)+2))-1)))"
iLastRow = Cells(Rows.Count, "I").End(xlUp).Row
With Range("L2")
..Formula = sFormula
..AutoFill .Resize(iLastRow - 5)
End With

sFormula = "=TODAY()"
iLastRow = Cells(Rows.Count, "I").End(xlUp).Row
With Range("AG2")
..Formula = sFormula
..AutoFill .Resize(iLastRow - 5)
End With

ActiveWorkbook.SaveCopyAs FileName:="H:\My
Documents\COMPLETED_FILES_CMS\FINAL_REPORT\" & _
bdFileName & Format(Now() - 1, "_YYYY_MM-DD") & _
".xls"



Application.DisplayAlerts = False
Workbooks.Close


End Sub