Need Help with the Following Macro--Copy & Paste

[rsrasc]

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

[Aussiebear]

Is it a simple typo with the copy range and destination range sizes being different? A8:J10 compared to A10:J90.

[Paul_Hossler]

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

[rsrasc]

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

[rsrasc]

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