Merge and move worksheets
 

Is there a way to merge multiple worksheets and after the data is merged.
each merged workbook is moved to a folder name complete. The code I'm using
is below. I have the merge part down, just need help with the move... Thanks
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.Cou nt)
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").Na me) = 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