urgent help required...optimise the macro and switching between two workbooks

[luvbite38]

Hi Gurus,

I need some help in optimising the following code and also in the last I want to switch on the newly saved workbook and save close that file. Please help
basically this peace of code is copying three worksheets from one workbook and copy pasting selective cells as value. Then this new workbook will be saved as a newworkbook based on cell value of the new workbook.

Later, i want the new Wb name to be added in the source workbook's lookups worksheets in column AL.
once it is added i want to switch back on the newly saved WB and close it. (i hope this all make sense???)

Sub AddtoDatabase()

Dim newFile As String, fName As String

Application.ScreenUpdating = False

    Sheets(Array("Scheme SummaryView1", "LSSP Matrix", "summaryRaw")).Select
    Sheets("summaryRaw").Activate
    Sheets(Array("Scheme SummaryView1", "LSSP Matrix", "summaryRaw")).Copy
    Sheets("summaryRaw").Select

    Range("B1:B6").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B9:B44").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D46:D52").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B48:B53").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Range("B55:B63").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B65:B69").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Range("B71:B165").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Range("B167:B168").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B169:B170").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Range("B172").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[-163]C*RC[3]+RC[4]*R[-162]C+R[-161]C*RC[5]"
    Range("B174,B173").Select
    Range("B173").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Application.CutCopyMode = False
    Selection.Copy
    Range("B173:B174").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=20
    Range("A177:B677").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False



    Range("C2").FormulaR1C1 = "=RC[-1]"
    Range("C2").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Replace What:="/", Replacement:="-", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Find(What:="/", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    Range("C2").Select

    
    
    
    
    Range("A1").Select
    fName = ActiveWorkbook.Sheets("SummaryRaw").Range("C2").Value

newFile = thisworkbook.Path & "\" & "Schemes\" & Format$(Now(), "mm-dd-yyyy_hhss") & " " & fName



  ChDir _
    thisworkbook.Path
    
    Application.DisplayAlerts = False

    ActiveWorkbook.SaveAs Filename:=newFile & ".xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

    ActiveWorkbook.Save
 
    ' to get the file name
    
    Dim newFile1 As String, fName1 As String
  
  fName1 = thisworkbook.Name
   Range("G1") = fName1
  Range("H1").FormulaR1C1 = _
        "=TRIM(LEFT(SUBSTITUTE(MID(CELL(""filename"",RC[-1])," & Chr(10) & "FIND(""["",CELL(""filename"",RC[-1]))+1,255),"".xl"",REPT("" "",255)),255))"
Range("h1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
        Range("h1").Select
        Selection.Copy
'  Dim newWB As String
'  Set newWB = Workbook
  
thisworkbook.Activate


 Sheets("lookups").Select

    Range("AL10000").Select
    Selection.Insert Shift:=xlDown
    Columns("AL:AL").Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("AL2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

   
   ActiveWorkbook.Close
Sheets("Add").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub