1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

hi need simple macro help!

Discussion in 'Business Applications' started by nickface, Jan 27, 2013.

Thread Status:
Not open for further replies.
  1. nickface

    nickface Thread Starter

    Joined:
    Jan 27, 2013
    Messages:
    1
    Hey all, i heard this was a well respected forum with good feedback. I need a little guidance...
    I have a master file 'Copy and Save.xlsm'. It contains 3 tabs: FR, GM, and CH.

    I want to save a copy of each tab to a new Excel file and name the file as Tab name - Master file name, e.g. FR - Copy and Save. xls. The master file is a Macro enabled Excel 2003 format and The new file need to be plain Excel 2003-2007 format rather than a Macro enabled format..(It should be ok to change the master file to Macro enabled format but the new files have to be Excel 2003 format...)

    My Macro is able to create a new workbook, save and name it but can't move on to the next tab...

    Sub copy_save()
    '
    ' Move and make a copy of each tab from the master file and save as a new workbook. Name it tab name - master file name
    '
    '
    ActiveSheet.Select
    pName = ActiveWorkbook.Path ' the path of the currently active file, the master file
    wbName = ActiveWorkbook.Name ' the file name of the currently active master file
    shtName = ActiveSheet.Name ' the name of the currently selected worksheet, the master file

    For i = 1 To Worksheets.Count

    ActiveSheet.Select
    ActiveSheet.Copy
    Tabname = pName & "\" & shtName & " - " & wbName 'Name the new workbook as: Tab name - master file name

    Dim Newshtname As String
    Newshtname = Tabname

    ActiveWorkbook.SaveAs Filename:= _
    Newshtname, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False


    Sheet(shtName).Activate ' want to Return to master file and move and save the next tab. This doesn't work however.

    Range("A1").Select

    ActiveSheet.Next.Select 'move to next tab

    Next i

    End

    End Sub
     
  2. Keebellah

    Keebellah Trusted Advisor

    Joined:
    Mar 27, 2008
    Messages:
    6,576
    First Name:
    Hans
    Hi, welcome to the forum:

    You should checkout Ron de Bruin's site.

    The code below is from his site and I edited it to suit my purpose.
    I'm sue you can find your solution here too.

    Code:
    Option Explicit
    
    ' Use VBA SaveAs and CheckCompatibility in Excel 2007-2010
    ' Ron de Bruin (last update 2-Jan-2010)
    ' http://www.rondebruin.nl/saveas.htm
    ' Code by Ron de Bruin on his site
    ' Editted by Hans Hallebeek, February 2010
    ' Changed code from sub to function and added the filepath and filename as parameters
    
    Function FileSaveAs(TempFilePath As String, TempFileName As String, Optional isNew As Boolean = True)
    'Working in Excel 97-2010
        Dim FileExtStr As String
        Dim FileFormatNum As Long
        Dim Sourcewb As Workbook
        Dim Destwb As Workbook
    
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
    
        Set Sourcewb = ActiveWorkbook
    
        'Copy the sheet to a new workbook
        'HH: Extra code to save a copy, not a new sheet
         If isNew Then ActiveSheet.Copy
        Set Destwb = ActiveWorkbook
    
        'Determine the Excel version and file extension/format
        With Destwb
            If Val(Application.Version) < 12 Then
                'You use Excel 97-2003
                FileExtStr = ".xls": FileFormatNum = -4143
            Else
                'You use Excel 2007-2010
                'We exit the sub when your answer is NO in the security dialog that you
                'only see when you copy a sheet from a xlsm file with macro's disabled.
                If Sourcewb.Name = .Name Then
                    With Application
                        .ScreenUpdating = True
                        .EnableEvents = True
                    End With
                    MsgBox "Your answer is NO in the security dialog"
                    Exit Function
                Else
                    Select Case Sourcewb.FileFormat
                    Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                    Case 52:
                        If .HasVBProject Then
                            FileExtStr = ".xlsm": FileFormatNum = 52
                        Else
                            FileExtStr = ".xlsx": FileFormatNum = 51
                        End If
                    Case 56: FileExtStr = ".xls": FileFormatNum = 56
                    Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                    End Select
                End If
            End If
        End With
    
        '    'Change all cells in the worksheet to values if you want
        '    With Destwb.Sheets(1).UsedRange
        '        .Cells.Copy
        '        .Cells.PasteSpecial xlPasteValues
        '        .Cells(1).Select
        '    End With
        '    Application.CutCopyMode = False
    
        'Save the new workbook and close it
    
        With Destwb
            .SaveAs TempFilePath & "\" & TempFileName & FileExtStr, FileFormat:=FileFormatNum
            If isNew Then .Close SaveChanges:=False
        End With
    
        If isNew Then MsgBox "You can find the new file in " & TempFilePath & Chr(10) & TempFileName & FileExtStr
    
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Function
    
    
     
As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/1087114

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice