Results 1 to 2 of 2

Thread: VBA - Help with Macro to Copy, Paste, Save, Print and Repeat

  1. #1

    VBA - Help with Macro to Copy, Paste, Save, Print and Repeat



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hello,

    I currently have this piece of work where I need to save and print a load of finance schedules for a group of clients that we have.

    I am new to writing VBA code and the majority of the work I have done with it before has been googling what I want to do and copying code that way.

    I have reached a point where I can't find what I want to do next on Google, So far I have:

    Sub CopyandPaste()
    Windows("Book2.xlsx").Activate
    Range("A2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Book1.xlsm").Activate
    Range("C7").Select
    AllSheets.Paste
    End Sub

    Sub CleanSave()
    Dim fileName As String
    fileName = "H:\Documents\" & strClean(Range("C7").Value) & " - " & strClean(Range("C8").Value) & ".xlsx"
    ActiveWorkbook.SaveAs fileName:=fileName, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

    End Sub

    Function strClean(strIn As String) As String
    Dim objRegex As Object
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
    .Pattern = "[\[\]|\/\\:\*\?""<>]"
    .Global = True
    strClean = .Replace(strIn, vbNullString)
    End With
    End Function

    Sub PrintWorkbook()
    ActiveWorkbook.PrintOut Copies:=1, Collate:=True
    End Sub

    Each individual sub works how I would like it to, what I want to do now is combine the subs and run the macro, and then for it to automatically run again, but instead of being A2 it would be A3, and then A4 etc. Everything else would be the same.

    Sorry If I haven't explained this very well, happy to clarify anything further

    Thanks
    Dan

  2. #2
    Conjurer WizzardOfOz's Avatar
    Join Date
    Sep 2013
    Location
    Australia
    Posts
    184
    Articles
    0
    Excel Version
    Office 365
    A few minor changes.

    No need to activate, activesheet, copy to clipboard etc. Slow and prone to errors, rather specify the whole address (book, sheet, range)
    You need to specify what sheet. I have assumed first sheet for both workbooks but this is bad practice. Instead of sheets(1) you need sheets("clients") or whatever you have named the sheet.

    I don't like calling external scripts to search and replace. You are allocating memory that you don't unassigne (need Set objRegex = Nothing). Do it a few times and you won't notice. Loop hundred of times and you will.
    Rather use basic code then external objects where you can.


    Code:
    Sub OneCode2RuleThemAll()
    Dim lrow As Long
    Dim oData, anItem
    
    
        'get the client list seperated by first blank item in column A
        With Workbooks("Book1").Sheets(1).Range("a2")
            lrow = .End(xlDown).Row
            oData = .Resize(lrow, 1).Value2
        End With
        
        For Each anItem In oData    'loop thru them
            Workbooks("Book2").Sheets(1).Range("C7").Value2 = anItem    'copy it
            CleanSave ("Book2")                                         'save it
            PrintWorkbook ("Book2")                                     'print it
        Next
        
    End Sub
    
    
    
    
    Sub CleanSave(ByVal sWorkbook As String)
    Dim fileName As String
        With Workbooks(sWorkbook).Sheets(1)     '<-----    presume sheet 1
            fileName = "H:\Documents\" & strClean(.Range("C7").Value2) & " - " & strClean(.Range("C8").Value2) & ".xlsx"
        End With
        Workbooks(sWorkbook).SaveAs fileName:=fileName, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    
    
    End Sub
    
    
    Function strClean(ByVal strIn As String) As String
    Const sBad As String = "[\[\]|\/\\:\*\?""<>]"
    Dim i As Long, sChar As String
        For i = 1 To Len(sBad)
            sChar = Mid(sBad, 1, 1)
    '        While InStr(strIn, sBad) > 0        'possibly loop incase not fully cleaned first time
                strIn = Replace(strIn, Mid(sBad, 1, 1), "")
    '        Wend
        Next i
        strClean = strIn
    End Function
    
    
    Sub PrintWorkbook(ByVal sWorkbook As String)
        Workbooks(sWorkbook).PrintOut Copies:=1, Collate:=True
    End Sub

Posting Permissions

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