VBA copy data from another workbook and paste in current workbook

TaskMaster

Board Regular
Joined
Oct 15, 2020
Messages
55
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi all,

I am wondering if you can help me with the following. I want to copy data from the workbook named Daily Stats saved in a specific location and copy into my current workbook called summary. The issue that im having is that the range of data that I want to copy changes with the date. I have tried to search for yesterdays date in the rows to determine the locations to copy and paste but not quite getting it correct. If anyone knows an easy fix I would appreciate it highly, thanks in advance.

Daily Stats.xlsx
ABCD
1DateSalePurchasesTotal
203/10/202238,3284,84133,487
304/10/20227,92710,680-2,753
405/10/202225,7508,08517,665
506/10/202224,1328,38115,751
607/10/202237,74949537,254
710/10/202242,5985,82136,777
811/10/20226,3372486,089
912/10/202217,3944,45312,941
1013/10/202248,4222,82845,594
1114/10/202210,7032,4558,248
1217/10/202231,7907,02824,762
1318/10/202222,6227,47915,143
1419/10/202243,5258,33435,191
1520/10/202230,61161829,993
1621/10/202220,26310,19110,072
1724/10/202243,8062,94340,863
1825/10/202229,2342,10327,131
1926/10/202219,4889,06810,420
2027/10/202212,6047,1495,455
2128/10/202240,72010,28430,436
2231/10/202219,4403,33016,110
Oct 22
Cell Formulas
RangeFormula
A3:A22A3=WORKDAY(A2,1)


Summary.xlsx
ABCDEFGHIJKLMNOPQRSTUVW
130/09/2022Oct 22
2TotalSLA03/10/202204/10/202205/10/202206/10/202207/10/202210/10/202211/10/202212/10/202213/10/202214/10/202217/10/202218/10/202219/10/202220/10/202221/10/202224/10/202225/10/202226/10/202227/10/202228/10/202231/10/2022
3456,629Sale/Purchases33,487-2,75317,66515,75137,25436,7776,08912,94145,5948,24824,76215,14335,19129,99310,07240,86327,13110,4205,45530,43616,110
Data
Cell Formulas
RangeFormula
B1B1=TEXT(A1+1,"MMM YY")
C2C2=WORKDAY(A1,1)
D2:W2D2=WORKDAY(C2,1)
A3A3=SUM(C3:W3)


VBA Code:
Dim ActiveWorkbook As String
Dim TodaysDate As String
Dim TName As String
Dim DailyStats As String
Dim FindRow As Range
Dim DStats As Range
Dim ColRef As String
Dim DS As String
Dim Wbk As Worksheet

TodaysDate = Evaluate(ThisWorkbook.Names("TDate").RefersTo) 'Defined Name containing previous wd date
TName = Evaluate(ThisWorkbook.Names("TabName").RefersTo) 'Defined Name containing tab name for daily state wb
ActiveWorkbook = ThisWorkbook.Worksheets("Data").Range("AC1") 'Name of workbook
DailyStats = "C:\Users\Flow\Desktop\Test\Daily Stats.xlsx"


Set FindRow = ThisWorkbook.Worksheets("Data").Rows(2).Find(What:=TodaysDate, LookIn:=xlValues, LookAt:=xlWhole)
ColRef = Split(Cells(, FindRow.Column).Address, "$")(1)


 With Workbooks(Worksheets("Data").Range("AC1").Value).ActiveSheet
 Set Wbk = Workbooks.Open(DailyStats, ReadOnly:=True)
 Set DStats = Wbk.Sheets(TName).Columns("A").Find(What:=TodaysDate, LookIn:=xlValues, LookAt:=xlWhole)
 DS = DStats.Row

.Range(ColRef & "2").Value = Wbk.Sheets("TName").Range("D" & DS).Value

Wbk.Close False

End With
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
It depends a little on how you are storing the date but on a copy of your workbook give this a try in a copy of your workbook.

Rich (BB code):
    ' Remove these 3 lines
    Dim DS As String
    Set DStats = Wbk.Sheets(TName).Columns("A").Find(What:=TodaysDate, LookIn:=xlValues, LookAt:=xlWhole)
    DS = DStats.Row
    
    ' Replace with these line
    Dim DS As Long
    With Application
       DS = .IfError(.Match(TodaysDate, Wbk.Sheets(TName).Columns("A"), 0), 0)
    End With
    
    If DS = 0 Then
        MsgBox "Date not found, exiting procedure"
        Exit Sub
    End If
 
Upvote 0
Solution
It depends a little on how you are storing the date but on a copy of your workbook give this a try in a copy of your workbook.

Rich (BB code):
    ' Remove these 3 lines
    Dim DS As String
    Set DStats = Wbk.Sheets(TName).Columns("A").Find(What:=TodaysDate, LookIn:=xlValues, LookAt:=xlWhole)
    DS = DStats.Row
  
    ' Replace with these line
    Dim DS As Long
    With Application
       DS = .IfError(.Match(TodaysDate, Wbk.Sheets(TName).Columns("A"), 0), 0)
    End With
  
    If DS = 0 Then
        MsgBox "Date not found, exiting procedure"
        Exit Sub
    End If

Hi thank you for your reply.

I am getting the MsgBox "Date not found, exiting procedure". I don't quite understand as the date is clearly listed there date that is currently being searched for is 31/10/2022.

VBA Code:
 With Workbooks(Worksheets("Data").Range("AC1").Value).ActiveSheet
   
      Set Wbk = Workbooks.Open(DailyStats, ReadOnly:=True)
     
    With Application
       DS = .IfError(.Match(TodaysDate, Wbk.Sheets(TName).Columns("A"), 0), 0)
    End With
   
       If DS = 0 Then
        MsgBox "Date not found, exiting procedure"
        Exit Sub
    End If
  
        .Range(ColRef & "10").Value = Wbk.Sheets(TName).Range("G" & DS).Value
        
      Wbk.Close False
     
End With
 
Upvote 0
1667832384208.png
1667832720367.png


The spreadsheet with the dates in column A is the sheet im wanting to copy data from and the workbook with the dates in row 2 is the sheet I want the data to be copied to.
 
Upvote 0
I have managed to find the reason why this wasn't working after your amendments

I added

VBA Code:
Dim fDate As Date

and replaced TodaysDate with fDate

Thank you for your assistance with this you really pushed me in the right direction.
 
Upvote 0
I have managed to find the reason why this wasn't working after your amendments

I added

VBA Code:
Dim fDate As Date

and replaced TodaysDate with fDate

Thank you for your assistance with this you really pushed me in the right direction.
I am not sure if you are still using Find or Match but if you are using a variable dimensioned as Date it will be safer to not just use fDate but to use CLng(fDate)
 
Upvote 0

Forum statistics

Threads
1,215,092
Messages
6,123,064
Members
449,090
Latest member
fragment

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