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

babar2019 · Sep 12, 2019

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:

DMTITL	DHACCT	DHDATE	DHDATC	DHITC	DHAMT	DESC1	DESC2
SIGNAPAY LTD IN PROCESS ACCOUN	xxxxxxxxxx	2019189	70819	55	259	Testing	Test Company
SIGNAPAY LTD IN PROCESS ACCOUN	xxxxxxxxxx	2019189	70819	55	499	Testing	Test Company
SIGNAPAY LTD IN PROCESS ACCOUN	xxxxxxxxxx	2019189	70819	55	2795.81	Testing	Test Company
SIGNAPAY LTD IN PROCESS ACCOUN	xxxxxxxxxx	2019189	70819	55	6000	Testing	Test Company
SIGNAPAY LTD IN PROCESS ACCOUN	xxxxxxxxxx	2019189	70819	55	6500	Testing	Test Company
SIGNAPAY LTD IN PROCESS ACCOUN	xxxxxxxxxx	2019190	70919	55	114	Testing	Test Company
SIGNAPAY LTD IN PROCESS ACCOUN	xxxxxxxxxx	2019191	71019	18	834.47	Testing	Test Company
SIGNAPAY LTD IN PROCESS ACCOUN	xxxxxxxxxx	2019191	71019	18	1590.7	Testing	Test Company
SIGNAPAY LTD IN PROCESS ACCOUN	xxxxxxxxxx	2019191	71019	18	2609.02	Testing	Test Company
SIGNAPAY LTD IN PROCESS ACCOUN	xxxxxxxxxx	2019191	71019	18	3294.32	Testing	Test Company
SIGNAPAY LTD IN PROCESS ACCOUN	xxxxxxxxxx	2019191	71019	18	4632.49	Testing	Test Company
SIGNAPAY LTD IN PROCESS ACCOUN	xxxxxxxxxx	2019191	71019	18	6667.57	Testing	Test Company

babar2019 · Oct 2, 2019

Hello,

I have posted a new thread and was able to rectify the error.

But there is a new request in the process which they noticed today while running.

Whenever the source file has 1st of the new month's date in column D, for example if its 10/01/2019, they not only want to copy paste rows from source to destination in the new month's tab but also rollover previous months data into the new month.

For example,

current process:

Today they got the source file data for 10/01/19
run macro
Paste's rows from source into 1019 tab of the destination file.

What they requested:
Today they got the source file data for 10/01/19
run macro
Paste rows from previous month's tab (0919) over to the current month's tab (1019) first and then copy rows from source to destination.
This process should run only if the source file has the date as 1st of the month in the column D. The process remains as the current process for the rest of the days.

I hope I was clear.

Thank you

mumps · Oct 3, 2019

Do you want the previous month's data to go below any already existing data in the destination sheet? Does the first of the month date appear in the first row for each account? Is it possible that some accounts may not have a first of the month date? It might help if you could upload a copy of the source file which includes first of the month dates. Please ensure that the data is representative of any possible date situations. Also, since you got a solution for the personal xlsb problem, I would assume that my macro had to be modified. If this is the case, could you please include the modified macro.

babar2019 · Oct 3, 2019

Hello,

Here's the link to the files: https://esquirebank.box.com/s/qcvjdzlqgrw2aux05wrc1i3v1z8d44hm

Please see source file has 4 rows for 10012019.
Previously what it would do was copy this 4 rows into the Signapay file in the 1019 tab.

But what they want is the previous month's tab 0919 data to also be copied from 0919 to 1019.

Please see tabs 0919 and 1019 of the destination file that I uploaded. I think it will be clear.

This should happen only if the source file date in column D is the 1st of the month. like 100119,110119,120119 etc..

Here is the updated macro below. I have highlighted what's changed in red.

Code:

Sub InProcessRecon()
    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 = [COLOR=#ff0000]Sheets[/COLOR]("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,TSYS IN PROCESS ACCOUNT,In Process DDA Recon - TSYS"
        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([COLOR=#ff0000]ActiveWorkbook[/COLOR].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"))
                    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))"
                    End With
                End With
            End If
        Next i
        wkbDest.Close True
    Next key
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

babar2019 · Oct 4, 2019

Hi, I keep getting the Runtime error 91 "object or with variable not set" on the code line 'wkbDest.Close True'I have a feeling the program is trying to open and close excel very quickly and running into issues. Can we please add some wait time in between open, pasting and closing?

Thank you

mumps · Oct 5, 2019

When I try the link you posted, it asks me to sign in to my account. Can you please upload to a site where I can download the files directly without having to sign in?

babar2019 · Oct 7, 2019

Good morning,

My bad. I didn't pick the right option under sharing.

Use the link here: https://esquirebank.box.com/s/qcvjdzlqgrw2aux05wrc1i3v1z8d44hm

Thank you

mumps · Oct 8, 2019

In the latest version of your destination file, the data starts at row 10. In the previous versions, the data started at row 12. The following macro is based on the data in all the destination files starting at row 10.

Code:

Sub InProcessRecon()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook, srcWS As Worksheet, desWS As Worksheet, LastRow As Long, key As Variant, totals As Long, 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, Day1 As String, prevWS As Worksheet
    Set srcWS = 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,TSYS IN PROCESS ACCOUNT,In Process DDA Recon - TSYS"
        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(ActiveWorkbook.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)
                    Day1 = Left(Right(sDate, 4), 2)
                    If Day1 = "01" Then
                        Set prevWS = Sheets("0" & Left(sDate, Len(sDate) - 4) - 1 & Right(sDate, 2))
                        With prevWS
                            Set desWS = ActiveWorkbook.Sheets(Format(DateSerial(Right(sDate, 2), Left(sDate, Len(sDate) - 4), Mid(sDate, Len(sDate) - 3, 2)), "mmyy"))
                            totals = .Range("C:C").Find("Reconciliation Totals").Row
                            totals1 = desWS.Range("C:C").Find("Reconciliation Totals").Row
                            RowCount = totals - 10
                            desWS.Cells(totals1, 1).EntireRow.Resize(RowCount).Insert Shift:=xlDown
                            .Range("A10:I" & totals - 1).Copy desWS.Cells(totals1, 1)
                        End With
totals1:
                        Set desWS = ActiveWorkbook.Sheets(Format(DateSerial(Right(sDate, 2), Left(sDate, Len(sDate) - 4), Mid(sDate, Len(sDate) - 3, 2)), "mmyy"))
                        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("B10:B" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                            .HorizontalAlignment = xlLeft
                        End With
                        With desWS.Range("C10:C" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Size = 10
                            .HorizontalAlignment = xlLeft
                        End With
                        With desWS.Range("D10:D" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                            .HorizontalAlignment = xlLeft
                        End With
                        With desWS.Range("E10: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("F10:F" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                        End With
                        With desWS
                            For Each code In .Range("E10: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(""F10:F""&ROW()-1))"
                            .Range("G" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""G10:G""&ROW()-1))"
                            .Range("H" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""H10:H""&ROW()-1))"
                            .Range("I" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""H10:H""&ROW()-1))+SUM(INDIRECT(""G10:G""&ROW()-1))"
                        End With
                    Else
                        GoTo totals1
                    End If
                End With
            End If
        Next i
        wkbDest.Close True
    Next key
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

babar2019 · Oct 8, 2019

That is correct. All the files have been adjusted to start at Row 10 which I modified in the macro but sorry didn't tell you.

I tested and it looks good. The only question I have is to make sure there is some type of timing added in between opening, copy paste and closing the excel worksheets.

Sometimes due to network issues, opening and closing excel quickly results in error on our end.

I'm okay if the process takes a minute or two more, but just want to make sure that it runs smooth everytime. This is a very rare issue but I was wondering if there is a way to mitigate this. All I could think about is to add 3-5 seconds after opening and after closing the excel workbook.

Let me know.

Thanks

mumps · Oct 8, 2019

Try inserting this line of code:

Code:

Application.Wait (Now + TimeValue("00:00:05"))

after

Code:

wkbDest.Close True

This will pause the macro for 5 seconds before opening the next file.

babar2019 · Nov 4, 2019

Hello,

Do you know what the below highlighted piece of code line is trying to do because the users are running into errors this morning and the debug mode takes me here.

Code:

[COLOR=#333333]Sub InProcessRecon()[/COLOR]    Application.ScreenUpdating = False
    Dim wkbDest As Workbook, srcWS As Worksheet, desWS As Worksheet, LastRow As Long, key As Variant, totals As Long, 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, Day1 As String, prevWS As Worksheet
    Set srcWS = 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,TSYS IN PROCESS ACCOUNT,In Process DDA Recon - TSYS"
        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(ActiveWorkbook.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)
                    Day1 = Left(Right(sDate, 4), 2)
                    If Day1 = "01" Then
                        [B][COLOR=#ff0000]Set prevWS = Sheets("0" & Left(sDate, Len(sDate) - 4) - 1 & Right(sDate, 2))[/COLOR][/B]
                        With prevWS
                            Set desWS = ActiveWorkbook.Sheets(Format(DateSerial(Right(sDate, 2), Left(sDate, Len(sDate) - 4), Mid(sDate, Len(sDate) - 3, 2)), "mmyy"))
                            totals = .Range("C:C").Find("Reconciliation Totals").Row
                            totals1 = desWS.Range("C:C").Find("Reconciliation Totals").Row
                            RowCount = totals - 10
                            desWS.Cells(totals1, 1).EntireRow.Resize(RowCount).Insert Shift:=xlDown
                            .Range("A10:I" & totals - 1).Copy desWS.Cells(totals1, 1)
                        End With
totals1:
                        Set desWS = ActiveWorkbook.Sheets(Format(DateSerial(Right(sDate, 2), Left(sDate, Len(sDate) - 4), Mid(sDate, Len(sDate) - 3, 2)), "mmyy"))
                        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("B10:B" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                            .HorizontalAlignment = xlLeft
                        End With
                        With desWS.Range("C10:C" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Size = 10
                            .HorizontalAlignment = xlLeft
                        End With
                        With desWS.Range("D10:D" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                            .HorizontalAlignment = xlLeft
                        End With
                        With desWS.Range("E10: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("F10:F" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                        End With
                        With desWS
                            For Each code In .Range("E10: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(""F10:F""&ROW()-1))"
                            .Range("G" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""G10:G""&ROW()-1))"
                            .Range("H" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""H10:H""&ROW()-1))"
                            .Range("I" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""H10:H""&ROW()-1))+SUM(INDIRECT(""G10:G""&ROW()-1))"
                        End With
                    Else
                        GoTo totals1
                    End If
                End With
            End If
        Next i
        wkbDest.Close True
    Next key
    Application.CutCopyMode = False
    Application.ScreenUpdating = True [COLOR=#333333]End Sub[/COLOR]

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

babar2019

Board Regular

babar2019

Board Regular

Excel Facts

mumps

Well-known Member

babar2019

Board Regular

babar2019

Board Regular

mumps

Well-known Member

babar2019

Board Regular

mumps

Well-known Member

babar2019

Board Regular

mumps

Well-known Member

babar2019

Board Regular

Similar threads

Forum statistics

Share this page

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

Board Regular

Board Regular

Excel Facts

Well-known Member

Board Regular

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock