Using Personal.xlsb - referencing active workbook in VBA

B

babar2019

Board Regular
Joined
Jun 21, 2019
Messages
93
Hello,

I have a macro which I saved it under a personal macro workbook as a few of our users would need to run it on a different workbook everyday using a shortcut command.

But when I do that, it keeps referenncing to the personal workbook and not the workbook that is being run from.

Can you please help? below is the macro.

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,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(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("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("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("G10:I10").Copy
.Range("G10: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))"
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
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Sort by date Sort by votes
Just posting to make the code a bit more readable if anyone wants to plough through it. @babar2019, you really do need to indent code and then use code tags when posting code.
I am not going to work my way through all the code but I can say that
Code: 
Set srcWS = ThisWorkbook.Sheets("QRYLIBA380.CSIPHIST>Sheet1")
needs changing to
Code: 
Set srcWS = Sheets("QRYLIBA380.CSIPHIST>Sheet1")
to start with.


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
    
    [COLOR="#FF0000"]Set srcWS = Sheets("QRYLIBA380.CSIPHIST>Sheet1")[/COLOR]
    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(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("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("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("G10:I10").Copy
                            .Range("G10: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))"
                        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
 
Last edited:
Upvote 0
Sorry I just copy/pasted thinking it would take the formatting. After making the changes suggested by you, I run into an error on the below code line highlighted in red. It says cannot find the file under personal workbook location instead of the location of my active workbook.

Set wkbDest = Workbooks.Open(ThisWorkbook.Path & "" & arr(i + 1) & ".xlsx")
 
Last edited:
Upvote 0
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,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
[COLOR=#ff0000]                Set wkbDest = Workbooks.Open(ThisWorkbook.Path & "\" & arr(i + 1) & ".xlsx")[/COLOR]
                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("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("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("G10:I10").Copy
                            .Range("G10: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))"
                        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
 
Last edited:
Upvote 0
babar2019 said:
It says cannot find the file under personal workbook location instead of the location of my active workbook.

Set wkbDest = Workbooks.Open(ThisWorkbook.Path & "" & arr(i + 1) & ".xlsx")
Click to expand...

You need to replace you have ThisWorkbook in your code with ActiveWorkbook. ThisWorkbook refers to the workbook the code is in i.e. the Personal workbook.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
Excel Macro Help
Replies
7
Views
801
Micron
M
S
  • Question Question
VBA to copy data from one worksheet to another (only specific columns)
Replies
2
Views
1K
SpireiteSteve
S
B
  • Question Question
Message prompt while running the macro
Replies
6
Views
597
babar2019
B
B
  • Question Question
Eliminate Weekends and Long weekends
Replies
4
Views
583
ranman256
ranman256
B
  • Question Question
Running macro on All Files based on vbYesNo
Replies
5
Views
502
JLGWhiz
JLGWhiz

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

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