Copy from one source file into multiple excel files - All live in one location

B

babar2019

Board Regular
Joined
Jun 21, 2019
Messages
93
Hello ,

I have an excel file which is the source document and I have other excel files which are destination files all in one location.

- I want VBA to open the source excel and Format the Date in Column C of the source to MM YYYY.
- Check if column A has the word 'SIGNAPAY' ,
- If true then open a document called 'In process SIGNAPAY.xlsx' from that location,
- Click on the sheet name which matches with Column C (MM YYYY) of the source excel.
- Copy rows through columns A:G in the source excel for all rows which have SIGNAPAY in column A and paste into the last empty rows in the 'In Process SIGNAPAY.xlsx' workbook.

Below is what the data would look like:



[TABLE="class: cms_table_cms_table_cms_table, width: 1031"]
<tbody>[TR]
[TD]DMTITL[/TD]
[TD]DHACCT[/TD]
[TD]DHDATE[/TD]
[TD]DHDATC[/TD]
[TD]DHITC[/TD]
[TD]DHAMT[/TD]
[TD]DESC1[/TD]
[TD]DESC2[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019189[/TD]
[TD="align: right"]70819[/TD]
[TD="align: right"]55[/TD]
[TD="align: right"]259[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019189[/TD]
[TD="align: right"]70819[/TD]
[TD="align: right"]55[/TD]
[TD="align: right"]499[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019189[/TD]
[TD="align: right"]70819[/TD]
[TD="align: right"]55[/TD]
[TD="align: right"]2795.81[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019189[/TD]
[TD="align: right"]70819[/TD]
[TD="align: right"]55[/TD]
[TD="align: right"]6000[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019189[/TD]
[TD="align: right"]70819[/TD]
[TD="align: right"]55[/TD]
[TD="align: right"]6500[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019190[/TD]
[TD="align: right"]70919[/TD]
[TD="align: right"]55[/TD]
[TD="align: right"]114[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019191[/TD]
[TD="align: right"]71019[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"]834.47[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019191[/TD]
[TD="align: right"]71019[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"]1590.7[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019191[/TD]
[TD="align: right"]71019[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"]2609.02[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019191[/TD]
[TD="align: right"]71019[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"]3294.32[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019191[/TD]
[TD="align: right"]71019[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"]4632.49[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
[TR]
[TD]SIGNAPAY LTD IN PROCESS ACCOUN[/TD]
[TD]xxxxxxxxxx[/TD]
[TD="align: right"]2019191[/TD]
[TD="align: right"]71019[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"]6667.57[/TD]
[TD]Testing[/TD]
[TD]Test Company[/TD]
[/TR]
</tbody>[/TABLE]

 
Sort by date Sort by votes
Maybe the easiest way would be for the macro to insert the date that it is run into a cell in each destination file, cell D1 for example, because it is unused. Then whenever the macro is run, it will check the date in D4 of each destination file and if that date is equal to the current date, that file would be skipped. Would that work for you?
 
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
I see.. Not sure what the effort is there but only if it is not a big thing. I'm also planning on adding a message box at the end to say 'In Process recon job completed successfully. Please check the Files'

Thank you
 
Upvote 0
Actually, The code is running perfectly fine when I insert a new module and paste the code and hit F5. But When I try to add that to a personal macro workbook and assign a shortcut key, it does not work.

Gives me an error 'Subscript out of Range' which errors out on line 'Set srcWS = ThisWorkbook.Sheets("QRYLIBA380.CSIPHIST>Sheet1")'

Do you know why this is happening?
 
Upvote 0
Below is the updated macro to take care of adding the date in cell D1 and adding the message at the end. Unfortunately, I don't have much experience working with a personal macro workbook.
Code: 
Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook, srcWS As Worksheet, desWS As Worksheet, LastRow As Long, key As Variant, totals1 As Long, totals2 As Long, fVisRow As Long
    Dim RngList As Object, rng As Range, arr As Variant, i As Long, fNames As String, code As Variant, sDate As String
    Set srcWS = ThisWorkbook.Sheets("QRYLIBA380.CSIPHIST>Sheet1")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    fNames = "SIGNAPAY LTD IN PROCESS ACCOUN,In Process DDA Recon - SignaPay,EPT 6001 IN PROCESS ACCOUNT,In Process DDA Recon - EPS,APS IN PROCESS ACCOUNT," & _
        "In Process DDA Recon - APS,PAYMENT WORLD IN PROCESS ACCT,In Process DDA Recon - Payment World,TRISOURCE IN PROCESS ACCOUNT," & _
        "In Process DDA Recon - TriSource,BANCTEK SOLUTIONS IN PROCESS,In Process DDA Recon - BancTek,MERCHANT BANCARD IN PROCESS,In Process DDA Recon - MBN," & _
        "ADVANCE MERCHANT IN PROCESS AC,In Process DDA Recon - DAS,2C PROCESSOR IN PROCESS,In Process DDA Recon - 2CP,FRONTLINE IN PROCESS ACCOUNT," & _
        "In Process DDA Recon - FrontLine,TITANIUM PROCESSING IN PROCESS,In Process DDA Recon - Titanium Processing,ARGUS MERCHANT IN PROCESS ACCT," & _
        "In Process DDA Recon - Argus,INFINITY CAPTIAL LLC IN PROCES,In Process DDA Recon - Choice,TITANIUM PAYMENTS IN PROCESS," & _
        "In Process DDA Recon - Titanium Payments,MERCHANT INDUSTR IN PROCESS,In Process DDA Recon - Merchant Industry,UNIFIED PAYMENTS IN PROCESS," & _
        "In Process DDA Recon - Unified,ELECTRONIC MERCHANT SYS IN PRO,In Process DDA Recon - EMS Conversion,MAVERICK IN PROCESS ACCOUNT," & _
        "In Process DDA Recon - Maverick,PIVOTAL PAYMENTS IN PROCESS,In Process DDA Recon - Nuvei,C&H FINANCIAL SERVICES IN PROC  In Process DDA Recon - C&H," & _
        "MERCHANT LYNX SERVICES IN PROC,In Process DDA Recon - Merchant Lynx"
        arr = Split(Application.Trim(fNames), ",")
    Set RngList = CreateObject("Scripting.Dictionary")
    For Each rng In srcWS.Range("A2", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp))
        If Not RngList.Exists(rng.Value) Then
            RngList.Add rng.Value, Nothing
        End If
    Next rng
    For Each key In RngList
        For i = 0 To UBound(arr)
            If arr(i) = key Then
                Set wkbDest = Workbooks.Open(ThisWorkbook.Path & "\" & arr(i + 1) & ".xlsx")
                With srcWS.Cells(1).CurrentRegion
                    .AutoFilter 1, key
                    fVisRow = srcWS.Range("A1", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
                    sDate = srcWS.Cells(fVisRow, 4)
                    Set desWS = ActiveWorkbook.Sheets(Format(DateSerial(Right(sDate, 2), Left(sDate, Len(sDate) - 4), Mid(sDate, Len(sDate) - 3, 2)), "mmyy"))
                    If desWS.Range("D1") <> Date Then
                        totals1 = desWS.Range("C:C").Find("Reconciliation Totals").Row
                        RowCount = srcWS.[subtotal(103,A:A)] - 1
                        desWS.Cells(totals1, 1).EntireRow.Resize(RowCount).Insert Shift:=xlDown
                        srcWS.Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(totals1, 2)
                        totals2 = desWS.Range("C:C").Find("Reconciliation Totals").Row
                        For Each rng In desWS.Range("B" & totals1 & ":B" & totals2 - 1)
                            rng = Format(DateSerial(Right(rng, 2), Left(rng, Len(rng) - 4), Mid(rng, Len(rng) - 3, 2)), "mm/dd/yy")
                        Next rng
                        With srcWS
                            .Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(totals1, 5)
                            .Range("F2:F" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(totals1, 6)
                            .Range("G2:G" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(totals1, 3)
                            .Range("H2:H" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(totals1, 4)
                        End With
                        srcWS.Cells(1).AutoFilter
                        totals2 = desWS.Range("C:C").Find("Reconciliation Totals").Row
                        With desWS.Range("B12:B" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                            .HorizontalAlignment = xlLeft
                        End With
                        With desWS.Range("C12:C" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Size = 10
                            .HorizontalAlignment = xlLeft
                        End With
                        With desWS.Range("D12:D" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                            .HorizontalAlignment = xlLeft
                        End With
                        With desWS.Range("E12:E" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                            .HorizontalAlignment = xlCenter
                            .Replace "55", "DR"
                            .Replace "78", "DR"
                            .Replace "18", "CR"
                            .Replace "38", "CR"
                        End With
                        With desWS.Range("F12:F" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                        End With
                        With desWS
                            For Each code In .Range("E12:E" & totals2 - 1)
                                If code = "DR" Then
                                    If code.Offset(, 1) > 0 Then
                                        code.Offset(, 1) = "-" & code.Offset(, 1)
                                    End If
                                    code.Offset(, 1).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
                                ElseIf code = "CR" Then
                                    code.Offset(, 1).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
                                End If
                            Next code
                        End With
                        With desWS
                            .Range("G12:I12").Copy
                            .Range("G13:I" & totals2 - 1).PasteSpecial Paste:=xlPasteFormulas
                            .Range("F" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""F12:F""&ROW()-1))"
                            .Range("G" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""G12:G""&ROW()-1))"
                            .Range("H" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""H12:H""&ROW()-1))"
                            .Range("I" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""I12:I""&ROW()-1))"
                        End With
                        desWS.Range("D1") = Date
                    Else
                        srcWS.Cells(1).AutoFilter
                    End If
                End With
            End If
        Next i
        wkbDest.Close True
    Next key
    MsgBox ("In Process recon job completed successfully.  Please check the Files.")
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thanks. Yeah, I'm trying to give it a shortcut key so they can run it everyday without having to go into the backend, insert the module, copy paste the code and hit F5.

But for some reason, it's not working. I'm looking into it as well.

Usually what I do is, create a personal macro workbook so the macro is available throughout and can be run using the shortcut command. But this one keeps erroring out.

I have a feeling wherever it says 'srcWS' in the code, we have to change it to reference the active open workbook from which the macro will be run.
 
Upvote 0
Try changing:
Code: 
Set srcWS = ThisWorkbook.Sheets("QRYLIBA380.CSIPHIST>Sheet1")
to
Code: 
Set srcWS = ActiveWorkbook.Sheets("QRYLIBA380.CSIPHIST>Sheet1")
 
Upvote 0
I think the only variable that we have not assigned is the Source Workbook to set it as active workbook and then set Active workbook = (""QRYLIBA380.CSIPHIST>Sheet1") as active worksheet ? It is somehow referencing the personal workbook. When I run using a shortcut command, it says Cannot find file under C:\Users\username\AppData\Roaming\Microsoft\Excel\XLSTART

Can you please look at this article below and see if we can adjust anything. This is exactly what my issue is:

https://stackoverflow.com/questions/39779576/using-personal-xlsb-referencing-active-workbook-in-vba

Thank you
 
Upvote 0
Try setting the reference using the workbook name:
Code: 
Set srcWS = Workbooks("QRYLIBA380.CSIPHIST.xlsm").Sheets("QRYLIBA380.CSIPHIST>Sheet1")
 
Upvote 0
May I suggest that you start a new thread and describe your problem. I'm sure another Forum member will be able to help. :(
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
Copy Paste data from one source document to multiple excel documents
Replies
0
Views
539
babar2019
B

Forum statistics

Threads
1,223,909
Messages
6,175,315
Members
452,634
Latest member
cpostell

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top