VBA Excel Macro not responding after execution - excel

Question

I am trying to import data from Report file to my workbook file. Also to do it automatically with different files with new data, so that I can update my rows in the workbook file. The code opens the Report file after executing but it is not responding.
Sub Weekly_Report()
Path = "C:\Users\Documents\Report"
Filename = Dir(Report & "*.xlsx")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Report, ReadOnly:=True
Loop
Dim starting_row As Long
header_exists = True 'If the file has a header and you don't want to import it, set this to True
starting_row = 1
If header_exists Then starting_row = 2
Dim first_blank_row As Long
first_blank_row = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row 'Finds the last blank row
Dim r As Long
r = starting_row
Dim Filenames As String
Filenames = Path
Dim found As Range
Row = Workbooks(Filenames).ActiveSheet.Range("a" & r).Value
Do While Not Row = ""
Set found = Columns("x:x").Find(what:=Row, LookIn:=xlValues, lookat:=xlWhole)
If found Is Nothing Then
write_line_from_export Filenames, r, first_blank_row
first_blank_row = first_blank_row + 1
Else
write_line_from_export Filenames, r, found.Row
End If
r = r + 1
Row = Workbooks(Filenames).ActiveSheet.Range("a" & r).Value
Loop
End Sub
Sub write_line_from_export(Filenames As String, s As Long, d As Long)
For e = 1 To 69
Cells(d, e).Value = Workbooks(Filenames).ActiveSheet.Cells(s, e).Value
Next e
End Sub

Answer 1

Try this:
Sub Weekly_Report()
Const HAS_HEADER As Boolean = True '<< use contants for fixed values
Const NUM_COLS As Long = 69
Dim Path, Filename, wbReport As Workbook, wsReport As Worksheet, m
Dim wsData As Worksheet, next_blank_row As Long, r As Long, c As Range, rwStart As Long
Path = "C:\Users\Documents\Report\"
Filename = Dir(Path & "Report*.xlsx") '???
Set wsData = ThisWorkbook.Worksheets("Data") 'for example: destination worksheet
next_blank_row = next_blank_row = wsData.Cells(Rows.Count, 1).End(xlUp).Row + 1 'next blank row (edited)
'make sure row is really empty...
Do While Application.CountA(wsData.Rows(next_blank_row)) > 0
next_blank_row = next_blank_row + 1
Loop
Do While Filename <> ""
Set wbReport = Workbooks.Open(Path & Filename) '<< get a reference to the workbook
Set wsReport = wbReport.Worksheets(1) '<< assumes only one sheet
rwStart = IIf(HAS_HEADER, 2, 1)
For r = rwStart To wsReport.Cells(Rows.Count, 1).End(xlUp).Row
'Match is faster than Find
m = Application.Match(wsReport.Cells(r, 1).Value, wsData.Columns("X"), 0)
If IsError(m) Then
m = next_blank_row 'no match - use next blank row and increment
next_blank_row = next_blank_row + 1
End If
'don't go cell-by-cell
wsData.Cells(m, 1).Resize(1, NUM_COLS).Value = _
wsReport.Cells(r, 1).Resize(1, NUM_COLS).Value
Next r
wbReport.Close False
Filename = Dir()
Loop
End Sub