Within Loop, Rename Sheets and Make Visible

  • Can someone help me with this??
    It's working but id'e like to add a few things.

    1) as the sheets are being copied from wb2 into wb1, rename the sheets to the name of wb2 its being copied from
    2) make the sheets in wb1, once copied, to become visble

    Private Sub Workbook_Open()
    'Accesses Outlook and saves the attachments
    'from the corresponding folders in my inbox (i.e., Fleet1, Fleet2, Fleet3)
    ' Call download_outlook_att_Fleet1
    ' Call download_outlook_att_Fleet2
    ' Call download_outlook_att_Fleet3

    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws As Worksheet
    Dim ws2 As Worksheet
    Dim mypath, myfile, myextension As String

    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = -xlCalculationManual

    mypath = "C:\Users\pjimerson\Documents\Engineering\End Of Shift Reports\Fleet 3\"
    myextension = "*.xlsm*"
    myfile = Dir(mypath & myextension)

    Set wb1 = ThisWorkbook
    Set NewSheet = wb1.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

    Do While myfile <> ""
    Set wb2 = Workbooks.Open(filename:=mypath & myfile, UpdateLinks:=Flase)
    wb2.Sheets("lists").Copy After:=(NewSheet)
    myfile = Dir

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = -xlCalculationAutomatic

    End Sub

    Thanks in advance!

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!