fixing problem copy data from multiple closed files

0

hello

I have   a problem   about   copy  data  from  multiple  closed workbooks   so  the  result  in  file  search      the  problem  is  copying data  before   the topics  headers  it  begins  copy  begin  from  row5   it  should  copy  from  row 6   and   it  causes copy   data   is  untidy   the  code  should  work  after  write  the  value  in  a2 in  search   file    based on  column  a  in  all  files in all sheets    then  bring  data   from  all  the  files  and  the  sheets  

i  hope  find  solution  for   this  problem 

Sub CopyData()
 Application.ScreenUpdating = False
 Dim srcWB As Workbook, desWS As Worksheet, ws As Worksheet, fnd As Range, LastRow As Long
 Set desWS = ThisWorkbook.Sheets("Search")
 LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 desWS.Range("A6:E" & LastRow).ClearContents
Const strPath As String = "C:\Users\OSE\Desktop\as\" 'change folder path to suit your needs
 ChDir strPath
 strExtension = Dir(strPath & "*.xlsx")
 Do While strExtension <> ""
  Set srcWB = Workbooks.Open(strPath & strExtension)
 For Each ws In srcWB.Sheets
 Set fnd = ws.Range("A:A").Find(desWS.Range("A2").Value, LookIn:=xlValues, lookat:=xlWhole)
 If Not fnd Is Nothing Then
 With desWS
 .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 5).Value = Array(srcWB.Name, fnd.Offset(, 1), fnd.Offset(, 2), fnd.Offset(, 3), ws.Name)
 End With
 End If
 Next ws
 srcWB.Close False
 strExtension = Dir
 Loop
 Application.ScreenUpdating = True
End Sub

thanks 

Answer
Discuss

Answers

0
Selected Answer

Leopard

You have a line (below) which sets the last row (to then delete table data) but if there's no data in your table, it could return 5 (the row value for your header row) and lead to row 5 being overwritten later. To correct for this possibility, just add the line in bold below to your existing code (in this extract):

LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 If LastRow < 6 Then LastRow = 6
 desWS.Range("A6:E" & LastRow).ClearContents
Hope this fixes it for you.
Discuss

Discussion

well done  !!  you  fixed    it ,  I  consider    this  is  the most  big  complicated  problem  i  faced  , you  know  why  I  said  that  because  my  friend  told  me   works  normally  without  any  problem   this  causes  for  me the  insanity   I  barly  lost  my  mind    thanks  very  much   you're  the  best !
leopard (rep: 54) Feb 16, '21 at 10:07 am
Thanks Leopard.

Sometimes it's easier to see the problem from "the outside" (though at first I couldn't see the problem). 
John_Ru (rep: 1072) Feb 16, '21 at 10:15 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login