Trying to merge multiple reports in one - excel

Question

Hi I've tried to merge multiple reports into one without success, first I set the code to let the user enter the path where folder containing multiple reports is located, and then put the code to open all and copy and paste in a new one, but no success.. VBA is not able to recognize second part and open the files.
Sub files()
Dim folderpath As String
Dim FileOpen As String
Dim DialogBox As FileDialog
Dim wbk As Workbook
Dim wbk1 As Workbook
Set wbk1 = ThisWorkbook
Dim Filename As String
folderpath = InputBox("Please introduce the path where files are stored", "Select Files' Path", "Paste path here")
FileOpen = Dir(folderpath & "\*.xls*")
Do While Len(Filename) > 0
Set wbk = Workbooks.Open(FileOpen)
wbk.Activate
Range(“A1”).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(“Book1”).Activate
Application.DisplayAlerts = False
Dim lr As Double
lr = wbk1.Sheets(“Sheet1”).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(“Sheet1”).Select
Cells(lr + 1, 1).Select
ActiveSheet.Paste
wbk.Close True
Filename = Dir
Loop
End Sub*

Answer 1

Copy Worksheets' Ranges to a New Workbook
Option Explicit
Sub CreateReport()
Dim sFolderPath As String
sFolderPath = InputBox("Please introduce the path where files are stored", _
"Select Files' Path", "Paste path here")
If Len(sFolderPath) = 0 Then Exit Sub
If Right(sFolderPath, 1) <> "\" Then sFolderPath = sFolderPath & "\"
Dim sFilename As String: sFilename = Dir(sFolderPath & "*.xls*")
If Len(sFilename) = 0 Then Exit Sub
Dim dwb As Workbook: Set dwb = Workbooks.Add(xlWBATWorksheet)
Dim dws As Worksheet: Set dws = dwb.Worksheets(1)
Dim dfCell As Range
Set dfCell = dws.Range("A1")
Dim swb As Workbook
Dim sws As Worksheet
Dim srg As Range
Dim sFilePath As String
Dim sCount As Long
Do While Len(sFilename) > 0
Set swb = Workbooks.Open(sFolderPath & sFilename)
On Error Resume Next ' test if the worksheet exists
Set sws = swb.Worksheets("Sheet1")
On Error GoTo 0
If Not sws Is Nothing Then ' worksheet exists
sCount = sCount + 1
If sCount = 1 Then ' with headers
Set srg = sws.Range("A1").CurrentRegion
Else ' without headers
With sws.Range("A1").CurrentRegion
Set srg = .Resize(.Rows.Count - 1).Offset(1)
End With
End If
srg.Copy dfCell
Set dfCell = dfCell.Offset(srg.Rows.Count)
Set sws = Nothing
'Else ' worksheet doesn't exist
End If
swb.Close SaveChanges:=False
sFilename = Dir
Loop
MsgBox "Report created out of " & sCount & " worksheets.", _
vbInformation, "CreateReport"
End Sub