Consulting

Results 1 to 5 of 5

Thread: Need Help with the Following Macro--Copy & Paste

  1. #1
    VBAX Regular
    Joined
    Apr 2011
    Posts
    72
    Location

    Need Help with the Following Macro--Copy & Paste

    Hello all,

    I'm using the following macro to copy and paste information from one file having approximately 15 tabs to other files.


    Like I said, the source file has approximately 15 tabs. In every tab I have the following information in Column A. The following information is listed in Column A. Of course, Column B through Column J has the monthly summary for these accounts. Column B has the information for Oct, Column C for Nov, and so on.


    44825 Circulation-Exercises/Maneuvers-Gross Sales (Sun)
    45110 Circulation-Direct Drops-Gross Sales
    45125 Circulation-Direct Drops-Gross Sales (Sun)
    54120 Promotions-Events
    54130 Promotions-Promotional items
    55120 Delivery Contracts-Contract Deliverers
    55410 Remote Printing-Printing
    55430 Remote Printing-Inserting
    55700 Outside Services
    56753 Rent (Lease)-Contract Services
    56820 Remote Offices-Utilities
    57340 Maintenance and Repair-Equip Service Contracts


    Basically, I need help with this macro so I can copy only the numbers starting with 5XXXX to the workbooks having a copy destination to the expense files listed in the macro and the ones starting with 4xxxx to be copy to the revenue files.

    The macro currently in use is working as intended but if someone can help with the macro to copy only the 4's and the 5's separately that will be great and will save me a lot of time.


    Thank you in advance for your assistance.

    Cheers!


    Sub CopyingFinancialInfo_SSX()
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("025-ENGAGEMENT-F").Range("A8:J90").Copy 
    Destination:=Workbooks("025 FY 2023 Expenses-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("102-CIRC DIR-IF-F").Range("A8:J90").Copy
    Destination:=Workbooks("102 FY 2023 Expenses-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("178-CIRC - IRAQ-F").Range("A8:J90").Copy
    Destination:=Workbooks("178 FY 2023 Expenses-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("180-CIRC -KUWAIT-F").Range("A8:J90").Copy
    Destination:=Workbooks("180 FY 2023 Expenses-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("181-CIRC-BAHRAIN-F").Range("A8:J90").Copy
    Destination:=Workbooks("181 FY 2023 Expenses-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("182-CIRC - QATAR-F").Range("A8:J90").Copy
    Destination:=Workbooks("182 FY 2023 Expenses-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("183-CIRC OTHER-F").Range("A8:J90").Copy
    Destination:=Workbooks("183 FY 2023 Expenses-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("184-CIRC ERI-F").Range("A8:J90").Copy
    Destination:=Workbooks("184 FY 2023 Expenses-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("190-CIRC-UAE-F").Range("A8:J90").Copy
    Destination:=Workbooks("190 FY 2023 Expenses-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("191-CIRC-JORDAN-F").Range("A8:J90").Copy
    Destination:=Workbooks("191 FY 2023 Expenses-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("350-EDITORIAL-F").Range("A8:J90").Copy
    Destination:=Workbooks("350 FY 2023 Expenses-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("400-GEN & ADMINI-F").Range("A8:J90").Copy
    Destination:=Workbooks("400 FY 2023 Expenses-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("178-CIRC - IRAQ-F").Range("A9:J90").Copy
    Destination:=Workbooks("178 FY 2023 Revenues-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("180-CIRC -KUWAIT-F").Range("A8:J90").Copy
    Destination:=Workbooks("180 FY 2023 Revenues-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("181-CIRC-BAHRAIN-F").Range("A8:J90").Copy
    Destination:=Workbooks("181 FY 2023 Revenues-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("182-CIRC - QATAR-F").Range("A8:J90").Copy
    Destination:=Workbooks("182 FY 2023 Revenues-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("183-CIRC OTHER-F").Range("A8:J90").Copy
    Destination:=Workbooks("183 FY 2023 Revenues-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("184-CIRC ERI-F").Range("A8:J90").Copy
    Destination:=Workbooks("184 FY 2023 Revenues-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("190-CIRC-UAE-F").Range("A8:J90").Copy
    Destination:=Workbooks("190 FY 2023 Revenues-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    Workbooks("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm").Sheets("191-CIRC-JORDAN-F").Range("A8:J90").Copy
    Destination:=Workbooks("191 FY 2023 Revenues-SSX-Budget.xlsx").Sheets("FY 23 Actual + Reforecast").Range("A10:J90")
    With ActiveSheet
            .Cells.Font.Name = "Calibri"
            .Cells.Font.Size = "10"
    End With
    End Sub
    Last edited by Aussiebear; 02-21-2023 at 11:08 AM. Reason: Reduction of whitespace and code layout

  2. #2
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,997
    Location
    Is it a simple typo with the copy range and destination range sizes being different? A8:J10 compared to A10:J90.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  3. #3
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Personally I think it'd be easier to copy everything and then delete

    I put the duplicate code in a sub

    There's still a lot of duplicated or near-duplicated text that could make it a little easier to maintain


    Option Explicit
    
    
    Sub CopyingFinancialInfo_SSX()
        
        Application.ScreenUpdating = False
    
    
        Call CopyAndDelete("FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm", "025-ENGAGEMENT-F", "A8:J90", _
                                     "025 FY 2023 Expenses-SSX-Budget.xlsx", "FY 23 Actual + Reforecast", "A10:J90")
        
        'etc
        'etc
        
        Application.ScreenUpdating = True
        Application.StatusBar = False
        
        MsgBox "Done"
        
    End Sub
    
    
    Private Sub CopyAndDelete(wb1 As String, ws1 As String, r1 As String, wb2 As String, ws2 As String, r2 As String)
        Dim rSrc As Range, rDest As Range
        Dim i As Long
        
        Application.StatusBar = wb2
        
        Set rSrc = Workbooks(wb1).Worksheets(ws1).Range(r1)
        Set rDest = Workbooks(wb2).Worksheets(ws2).Range(r2)
        
        rSrc.Copy Destination:=rDest
    
    
        With rDest
            For i = .Rows.Count To 1 Step -1
                If Left(.Cells(i, 1).Value, 1) <> "4" And Left(.Cells(i, 1).Value, 1) <> "5" Then .Rows(i).Delete
            Next i
        End With
    
    
        With rDest.Parent.Cells.Font
            .Name = "Calibri"
            .Size = "10"
        End With
    End Sub

    Sub CopyingFinancialInfo_SSX_2()
        Dim wb1 As String, r1 As String, ws2 As String, r2 As String
        
        wb1 = "FY 23-SSX-YTD Actuals-Oct 22-Sep 23-Revenues and Expenses-Dec 22.xlsm"
        r1 = "A8:J90"
        ws2 = "FY 23 Actual + Reforecast"
        r2 = "A10:J90"
        
        
        Application.ScreenUpdating = False
    
    
        Call CopyAndDelete(wb1, "025-ENGAGEMENT-F", r1, "025 FY 2023 Expenses-SSX-Budget.xlsx", ws2, r2)
        
        'etc
        'etc
        
        Application.ScreenUpdating = True
        Application.StatusBar = False
        
        MsgBox "Done"
        
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  4. #4
    VBAX Regular
    Joined
    Apr 2011
    Posts
    72
    Location
    Hello Aussibea, yes, it was a typo in the post but the code is correct. No issues with that.

    Paul, thank you for the code. I will try it in the morning--Germany time--it is 2319 here. Just finished watching the soccer game Liverpool-Real Madrid.

    Time to go!

    Again, thank you for taking the time to put this together.

    Will let you know in the morning.

    Regards,

    rsrasc

  5. #5
    VBAX Regular
    Joined
    Apr 2011
    Posts
    72
    Location
    Hi Paul,

    Thank you again for the code. Got a question, after running the following "Sub CopyingFinancialInfo_SSX()" should I run the next code that has the following info: "Private Sub CopyAn......", right? So, that's what I did but I don't see any changes or the output from running the first code is still the same.

    Would you please help me understand what the Private Sub ... code does?

    Now, looking at the code under the following Sub------"
    Sub CopyingFinancialInfo_SSX_2", then seems to be that the code in there is similar to first code. I ran both code and I'm getting similar results. Is that correct or is there any difference between the two?

    Please let me know if you have any questions or need additional information to clarify what I'm saying...

    Regards,
    rsrasc














Posting Permissions

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