Advertisement
YasserKhalil2019

T3877_Get Data From Closed Workbook Public Procedure

Sep 9th, 2019
168
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.58 KB | None | 0 0
  1. https://excel-egy.com/forum/t3877
  2. ---------------------------------
  3.  
  4. Sub Test()
  5. 'Q8 >> Cell With Workbook Name | Q12 >> First Cell To Put Results
  6. '----------------------------------------------------------------
  7. GetDataFromClosedWorkbook "Q8", "Q12"
  8. End Sub
  9.  
  10. Sub GetDataFromClosedWorkbook(sFileCell As String, sStartCell As String)
  11. Dim wb As Workbook
  12. Dim ws As Worksheet
  13. Dim a As Variant
  14. Dim strFileName As String
  15. Dim sFilter As String
  16.  
  17. Set ws = ThisWorkbook.Worksheets("UIR")
  18. strFileName = ThisWorkbook.Path & "\" & ws.Range(sFileCell).Value & ".xlsx"
  19. sFilter = "$F$11:$F$141"
  20.  
  21. Application.ScreenUpdating = False
  22. With ws.Range(sStartCell)
  23. .Resize(.CurrentRegion.Rows.Count, 4).ClearContents
  24. End With
  25. ws.Range(sFilter).AutoFilter Field:=1
  26.  
  27. If Len(Dir(strFileName)) > 0 Then
  28. Set wb = Workbooks.Open(Filename:=strFileName)
  29. With wb.Worksheets(1)
  30. .Range(sFilter).AutoFilter Field:=1
  31. a = .Range("Q12").Resize(.Range("Q12").CurrentRegion.Rows.Count, 4).Value
  32. ws.Range(sStartCell).Resize(UBound(a, 1), UBound(a, 2)).Value = a
  33. .Parent.Close False
  34. End With
  35.  
  36. ws.Range(sFilter).AutoFilter Field:=1, Criteria1:="1"
  37. Application.Goto ws.Range("S2")
  38. Else
  39. MsgBox strFileName & " Can't Be Found!", vbExclamation, "File Not Found"
  40. End If
  41. Application.ScreenUpdating = True
  42. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement