View Single Post
 
Old 04-21-2018, 09:04 AM
NoSparks NoSparks is offline Windows 7 64bit Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 842
NoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of light
Default

This of any help?
You could apply the required "adjustments" after this.
Code:
Sub GetPlanStatus()
        
    Dim wb As Workbook, src As Workbook
    Dim sht As Worksheet, cel As Range
    
Set sht = ThisWorkbook.ActiveSheet
'remove existing data
With sht.UsedRange.Offset(1)
    .Borders.LineStyle = xlNone
    .ClearContents
End With
'see if source is open
For Each wb In Application.Workbooks
    If wb.Name = "SearchResultsDaily " & Format(Date, "m.dd.yy") & ".xls" Then
        Set src = wb
        Exit For
    End If
Next wb
'if yes copy data
If Not src Is Nothing Then
    src.Sheets(1).UsedRange.Offset(1).Copy
'if no display message and quit
Else
    MsgBox "Workbook   " & Chr(34) & "SearchResultsDaily " & _
            Format(Date, "m.dd.yy") & ".xls" & Chr(34) & "   is not open."
    Exit Sub
End If
'paste the copied data
With sht
    .Cells(2, 1).PasteSpecial (xlPasteValues)
    'name sheet
    .Name = Left(src.Name, Len(src.Name) - 4)
    ' E from F if blank
    For Each cel In Intersect(.Columns("E"), .UsedRange)
        If cel.Value = "" Then cel.Value = cel.Offset(, 1).Value
    Next cel
    'position the cursor
    .Cells(1).Select
End With
'stop the marching ants
Application.CutCopyMode = False

End Sub
Reply With Quote