Advertisement
YasserKhalil2019

T4535_Loop Through Closed Workbooks General Ehsaa

Jan 17th, 2020
154
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/t4535
  2. ---------------------------------
  3.  
  4. Sub Loop_Through_Closed_Workbooks_General_Ehsaa()
  5. Dim x, wb As Workbook, ws As Worksheet, sFile As String, i As Integer
  6.  
  7. Application.ScreenUpdating = False
  8. sFile = Dir(ThisWorkbook.Path & "\*.xls*")
  9.  
  10. Do While sFile <> ""
  11. If ThisWorkbook.Name <> sFile Then
  12. Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & sFile, False)
  13. Set ws = wb.Worksheets(1)
  14.  
  15. For i = 1 To ThisWorkbook.Worksheets.Count
  16. With ThisWorkbook.Worksheets(i)
  17. x = Application.Match(CStr(Split(sFile, ".")(0)), .Columns(2), 0)
  18. If Not IsError(x) Then
  19. If i = 1 Then
  20. .Range("C" & x).Resize(1, 13).Value = ws.Cells(i + 17, "C").Resize(1, 13).Value
  21. .Range("P" & x).Resize(1, 4).Value = ws.Cells(i + 17, "T").Resize(1, 4).Value
  22. .Range("T" & x).Resize(1, 4).Value = ws.Cells(i + 17, "Z").Resize(1, 4).Value
  23. Else
  24. .Range("C" & x).Resize(1, 27).Value = ws.Cells(i + 17, "C").Resize(1, 27).Value
  25. End If
  26. End If
  27. End With
  28. Next i
  29.  
  30. wb.Close False
  31. End If
  32.  
  33. sFile = Dir
  34. Loop
  35. Application.ScreenUpdating = True
  36.  
  37. MsgBox "Done...", 64
  38. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement