Copy and Paste from one workbook to another...

[RandyD123]

All,

When I run the code below, it opens yesterday's DOR (DO Report 10-18-23). It works perfectly. What I'm looking to do is when that code is run and yesterdays' DOR opens I want it to copy N5 thru O41 and then I need to paste that into the workbook I'm working on which is different every day, it will already be open it's name will be "10-18-23". When I do this tomorrow the workbook I will be working from will be "10-19-23"......and so on. I need it to be pasted on the "Sheet1" tab D11 thru E47

All the codes are run from from the sheet with with yesterday's date "10-18-23". This is because I use a template that is read only and they have to do a "save as" and that how the sheet gets it's name...(10-18-23) and so on.

Any help would be much appreciated. Thank You.

Sub OpenDOR()
  
    Dim wbMyWorkbook    As Workbook
    Dim strWBName       As String, strWBPathStub  As String
    Dim strWBPath       As String, FullName As String
    Dim i               As Long
  
    strWBName = "DO Report " & Format(DateAdd("d", -1, Date), "mm-dd-yy") & ".xlsm"        'yesterday's DO report
    strWBPathStub = "https://ustsa.sharepoint.com/sites/Airport-R1-MHT/soc/SOC Scheduling/Shared Documents/DOR"
  
    Application.DisplayAlerts = False
    On Error Resume Next
    For i = 1 To 3
        strWBPath = Choose(i, strWBPathStub, _
                              strWBPathStub & "/" & Format(DateAdd("d", -1, Date), "yyyy.mm"), _
                              strWBPathStub & "/Archived/")
        FullName = strWBPath & "\" & strWBName
        Set wbMyWorkbook = Workbooks.Open(FullName, 0, False)
        If Not wbMyWorkbook Is Nothing Then GoTo exitsub
    Next i
  
    MsgBox "Failed To Locate " & strWBName, 48, "Not Found"
  
exitsub:
    Application.DisplayAlerts = True
    On Error GoTo 0
    
End Sub

 

[Muhammad_Usman]

Please Check this code

Sub OpenDORAndCopyPaste()
    Dim wbMyWorkbook As Workbook
    Dim strWBName As String, strWBPathStub As String
    Dim strWBPath As String, FullName As String
    Dim i As Long
    
    ' Construct the name of the DO report workbook (yesterday's date)
    strWBName = "DO Report " & Format(DateAdd("d", -1, Date), "mm-dd-yy") & ".xlsm"
    strWBPathStub = "https://ustsa.sharepoint.com/sites/Airport-R1-MHT/soc/SOC Scheduling/Shared Documents/DOR"
    
    ' Disable display alerts to suppress messages
    Application.DisplayAlerts = False
    On Error Resume Next
    
    ' Loop through the possible locations
    For i = 1 To 3
        strWBPath = Choose(i, strWBPathStub, _
                          strWBPathStub & "/" & Format(DateAdd("d", -1, Date), "yyyy.mm"), _
                          strWBPathStub & "/Archived/")
        FullName = strWBPath & "\" & strWBName
        
        ' Attempt to open the DO report workbook
        Set wbMyWorkbook = Workbooks.Open(FullName, 0, False)
        If Not wbMyWorkbook Is Nothing Then
            Exit For ' Workbook found, exit the loop
        End If
    Next i
    
    ' Check if the DO report workbook was found
    If wbMyWorkbook Is Nothing Then
        MsgBox "Failed To Locate " & strWBName, 48, "Not Found"
    Else
        ' Workbook found, now copy N5:O41
        wbMyWorkbook.Sheets("Sheet1").Range("N5:O41").Copy
        ' Activate the destination workbook (today's date)
        Workbooks(Format(Date, "mm-dd-yy") & ".xlsm").Activate
        ' Paste into D11:E47
        ActiveSheet.Range("D11").PasteSpecial Paste:=xlPasteValues
        ' Close the DO report workbook without saving
        wbMyWorkbook.Close SaveChanges:=False
    End If
    
    ' Enable display alerts again
    Application.DisplayAlerts = True
    On Error GoTo 0
End Sub

 

[RandyD123]

I think that that the part that says. Workbooks(Format(Date, "mm-dd-yy") might be wrong because it is yesterday's date that it should be looking for. It seems to open the correct DOR but the paste into "10-18-23" doesn't work. Remember, tomorrow the file that I would be working from will be "10-19-23"

   Else
        ' Workbook found, now copy N5:O41
        wbMyWorkbook.Sheets("Sheet1").Range("N5:O41").Copy
        ' Activate the destination workbook (today's date)
       [COLOR=rgb(97, 189, 109)] Workbooks(Format(Date, "mm-dd-yy") & ".xlsm").Activate[/COLOR]
        ' Paste into D11:E47
        ActiveSheet.Range("D11").PasteSpecial Paste:=xlPasteValues
        ' Close the DO report workbook without saving
        wbMyWorkbook.Close SaveChanges:=False
    End If

 

[RandyD123]

I'm guessing that my post probably wasn't clear enough. So let me try this. I work with 2 workbooks everyday. Everything is based on yesterdays date.

The first workbook I open is yesterdays workbook.... for example today is the 19th so I open a workbook called "10-18-23". In this workbook are tabs... "Summary, Data, 1-2, ......Sheet1"
The second workbook I need is opened by way the macro and it is called "DO Report 10-18-23"

When the DOR macro is run, it opens yesterday's DOR and the code is fine. In the "DO Report 10-18-23" I need the macro to continue and copy N5:041 and then paste that info into the workbook that I already have open (10-18-23) and paste that info into "Sheet1" D11:E47.

Not sure if that is any clearer, but I thank you for any help!

 

[RandyD123]

I've got this and even though I don't get any errors it doesn't work.

    ' Check if the DO report workbook was found
    If wbMyWorkbook Is Nothing Then
        MsgBox "Failed To Locate " & strWBName, 48, "Not Found"
    Else
        ' Workbook found, now copy N5:O41
        wbMyWorkbook.Sheets("MR").Range("N5:O41").Copy
        ' Activate the destination workbook (today's date)
        Workbooks(Format(Date, "mm-dd-yy" - 1) & ".xlsm").Activate
        ' Paste into D11:E47
        ActiveSheet.Range("D11").PasteSpecial Paste:=xlPasteValues
        ' Close the DO report workbook without saving
        wbMyWorkbook.Close SaveChanges:=False
    End If
    
    ' Enable display alerts again
    Application.DisplayAlerts = True
    On Error GoTo 0
End Sub

 

[Joe4]

If you want this line to reflect yesterday's date:

Workbooks(Format(Date, "mm-dd-yy" - 1) & ".xlsm").Activate

in should be written like this instead:

Workbooks(Format(Date - 1, "mm-dd-yy") & ".xlsm").Activate

(you need to subtract one from the date, not from the format!)

 

[RandyD123]

Ok I got this to work, except I have to be on the Sheet1 tab for it to work. When I open my workbook (10-18-23) I have mutiple tabs on that sheet. I want to run my code from the "Summary" tab. But it won't work unless I am on the "Sheet1" tab. As you can see from the code below in order for me to make it work I have to run the first vba and then call the second vba. How can I incorporate both into one so I can run it from the "Summary" tab?

Sub OpenSheet1()

       Worksheets("Sheet1").Activate
     
       Call MagicButton

End Sub

Sub MagicButton()
    Dim wbMyWorkbook As Workbook
    Dim strWBName As String, strWBPathStub As String
    Dim strWBPath As String, FullName As String
    Dim i As Long
    
    ' Construct the name of the DO report workbook (yesterday's date)
    strWBName = "DO Report " & Format(DateAdd("d", -1, Date), "mm-dd-yy") & ".xlsm"
    strWBPathStub = "https://ustsa.sharepoint.com/sites/Airport-R1-MHT/soc/SOC Scheduling/Shared Documents/DOR"
    
    ' Disable display alerts to suppress messages
    Application.DisplayAlerts = False
    On Error Resume Next
    
    ' Loop through the possible locations
    For i = 1 To 3
        strWBPath = Choose(i, strWBPathStub, _
                          strWBPathStub & "/" & Format(DateAdd("d", -1, Date), "yyyy.mm"), _
                          strWBPathStub & "/Archived/")
        FullName = strWBPath & "\" & strWBName
        
        ' Attempt to open the DO report workbook
        Set wbMyWorkbook = Workbooks.Open(FullName, 0, False)
        If Not wbMyWorkbook Is Nothing Then
            Exit For ' Workbook found, exit the loop
        End If
    Next i
    
    ' Check if the DO report workbook was found
    If wbMyWorkbook Is Nothing Then
        MsgBox "Failed To Locate " & strWBName, 48, "Not Found"
    Else
        ' Workbook found, now copy N5:O41
        wbMyWorkbook.Sheets("MR").Range("N5:O41").Copy
        ' Activate the destination workbook (today's date)
        Workbooks(Format(Date - 1, "mm-dd-yy") & ".xlsm").Activate
        ' Paste into D11:E47
        wbMyWorkbook.Sheets("Sheet1").Range
        ActiveSheet.Range("D11").PasteSpecial Paste:=xlPasteValues
        ' Close the DO report workbook without saving
        wbMyWorkbook.Close SaveChanges:=False
    End If
    
    ' Enable display alerts again
    Application.DisplayAlerts = True
    On Error GoTo 0
End Sub