1 Sub ArchivetoDB()
2
3 Dim Lrow As Integer
4 Dim itr As Integer
5 Dim db As Worksheet
6
7 Set db = Worksheets("Archive DataBase")
8 Lrow = Worksheets("Archive").Cells(Rows.Count, 1).End(xlUp).Row
9
10 For itr = 2 To Lrow
11  Application.CutCopyMode = True
12    Worksheets("Archive").Select
13     'Select Sheet Name to Archive
14      Worksheets("Archive").Range("A" & itr).Select
15      Worksheets(Selection.Value).Activate
16     'Copy selected sheet
17      Worksheets(Selection.Value).Cells.Copy
18     'Paste sheet to Archive DataBase
19      db.Paste
20      DoEvents
21    Application.CutCopyMode = False
22  Next itr
23
24 End Sub