Results 1 to 3 of 3
  1. #1
    New Lounger
    Join Date
    Jul 2014
    Posts
    17
    Thanks
    7
    Thanked 0 Times in 0 Posts

    VBA Move a renamed sheet to a master sheet...

    The below code is what I am having issues with. Basically I want it to loop through a folder that I have set open every file rename 2 worksheets and then move these to the Dealer Planning rollup. The issue I am having is how to reference the sheets with the changed name and actually move them. With the code currently it just copies the first two worksheets in the rollup file and then moves it rather than pulling from each individual spreadsheet that it opens. Thanks in advance for any help on this issue.


    Code:
    Public Sub test()
    'DECLARE AND SET VARIABLES
    Dim wbk As Workbook
    Dim Filename As String
    Dim Path As String
    Path = "C:\Users\f18023b\Desktop\Test\"  'CHANGE PATH
    Filename = Dir(Path & "*.xlsx")
    '--------------------------------------------
    'OPEN EXCEL FILES
     Do While Len(Filename) > 0  'IF NEXT FILE EXISTS THEN
        Application.ScreenUpdating = False
        Set wbk = Workbooks.Open(Path & Filename)
    
    
    Dim Dealer As String
    
    Dealer = ActiveWorkbook.Sheets("Inputs").Range("B5")
    
    'rename sheets to dealer specific
    
        Sheets("2015 Plan").Name = "15 Plan" & " " & ActiveWorkbook.Sheets("Inputs").Range("B3").Value & "-" & ActiveWorkbook.Sheets("Inputs").Range("B4").Value & "-" & Right(Dealer, 7)
        Sheets("2015 DRY Plan").Name = "15 DRY Plan" & " " & ActiveWorkbook.Sheets("Inputs").Range("B3").Value & "-" & ActiveWorkbook.Sheets("Inputs").Range("B4").Value & "-" & Right(Dealer, 7)
        'move sheets to rollup
        
        ActiveWorkbook.Sheets(2).Copy Before:=Workbooks("Dealer Planning Rollup.xlsm").Sheets _
            (7)
        ActiveWorkbook.Sheets(3).Copy Before:=Workbooks("Dealer Planning Rollup.xlsm").Sheets _
            (7)
         'MsgBox Filename & " has opened"  'OPTIONAL- CAN COMMENT OUT
        'wbk.Close False  'close open file and don't save
        Filename = Dir
    Loop
    Application.ScreenUpdating = True
    End Sub

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,633
    Thanks
    115
    Thanked 647 Times in 590 Posts
    Balla,

    If I am understanding you correctly, from an open workbook you want to run a macro that will cycle though a folder and successively open spreadsheet files that have at least 3 worksheets with the same names: "Inputs", 2015 Plan", and "2015 DRY Plan". Once open, you want to rename 2 sheets in each of the files to some concatenated name ending with the last right 7 character of the value in B5 on the "Inputs" sheet of that workbook. You then want to copy these two renamed sheets to a third workbook. If this is correct then see if this modification is what you are looking for.

    Maud

    Code:
    Public Sub test()
    Application.ScreenUpdating = False
    '--------------------------------------------
    'DECLARE AND SET VARIABLES
    Dim wbk As Workbook
    Dim Filename As String
    Dim Path As String
    Dim ws1 As String
    Dim ws2 As String
    Dim Dealer As String
    Path = "C:\Users\Maudibe\Desktop\New folder (2)\"  'CHANGE PATH
    Filename = Dir(Path & "*.xlsx")
    '--------------------------------------------
    'OPEN EXCEL FILES
     Do While Len(Filename) > 0  'IF NEXT FILE EXISTS THEN
        Set wbk = Workbooks.Open(Path & Filename)
    '--------------------------------------------
    'RENAME AND COPY SHEETS
        Dealer = ActiveWorkbook.Sheets("Sheet1").Range("B5")
        ws1 = "15 Plan" & " " & ActiveWorkbook.Sheets("Inputs").Range("B3").Value & "-" & ActiveWorkbook.Sheets("Inputs").Range("B4").Value & "-" & Right(Dealer, 7)
        ws2 = "15 DRY Plan" & " " & ActiveWorkbook.Sheets("Inputs").Range("B3").Value & "-" & ActiveWorkbook.Sheets("Inputs").Range("B4").Value & "-" & Right(Dealer, 7)
        wbk.Sheets("2015 Plan").Name = ws1
        wbk.Sheets("2015 DRY Plan").Name = ws2
    '--------------------------------------------
    'INSERT SHEETS IN DESTINATION WORKBOOK
        wbk.Sheets(ws1).Select
        wbk.Sheets(ws1).Copy Before:=Workbooks("Dealer Planning Rollup.xlsm").Sheets(7)
        wbk.Activate
        wbk.Sheets(ws2).Select
        wbk.Sheets(ws2).Copy Before:=Workbooks("Dealer Planning Rollup.xlsm").Sheets(7)
        Filename = Dir
    Loop
    Application.ScreenUpdating = True
    End Sub
    Last edited by Maudibe; 2014-07-17 at 22:20.

  3. The Following User Says Thank You to Maudibe For This Useful Post:

    balla506 (2014-07-18)

  4. #3
    New Lounger
    Join Date
    Jul 2014
    Posts
    17
    Thanks
    7
    Thanked 0 Times in 0 Posts
    This did the trick. Thanks for your help on this.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •