VBA copy data range from worksheets into new workbook

[newyears]

I have been searching the forum looking for an answer, but I can't find exactly what I'm looking for. I have issues trying to copy and index the paste. I appreciate any help

Here is what I'm trying to do:

User selects file that has multiple worksheets with different names. I want to copy rows 8 thru 15 from each worksheet into different workbook with sheet named "data" starting at row 1 and then pasting it. Data from next sheet (same file user selected) would be pasted below the first data set pasted -- all in workbook sheet named "data". It would loop thru each sheet and paste data below previous paste into workbook with sheet named "data".


Here is my code with copy and pasting...I used worksheet name "result" to copy one cell and paste in another workbook sheet "data". The user selected file has several different worksheet names (10 total), so I do not know how to loop and copy and paste advancing each paste.

    Dim Filter As String, Title As String
    Dim result As String
    Dim FilterIndex As Integer
    Dim wbsource As Workbook
        
    Dim wbdest As Workbook
    Set wbdest = ActiveWorkbook
        Dim Filename As Variant
        FFilter = "Excel Files (*.xls),*.xls," & _
        "Text Files (*.txt),*.txt," & _
        "All Files (*.*),*.*"
' Default Filter to *.*
FilterIndex = 3
Title = "Select a File to Open"
ChDrive ("c")
ChDir ("C:\Users\")
With Application
    ' ile Name to selected FileSet F
    Filename = .GetOpenFilename(Filter, FilterIndex, Title)
    ' Reset Start Drive/Path
    ChDrive (Left(.DefaultFilePath, 1))
    ChDir (.DefaultFilePath)
End With
' Exit on Cancel
If Filename = False Then
    MsgBox "No file was selected."
    Exit Sub
End If
Application.ScreenUpdating = False
    
wbdest.Unprotect
Set wbsource = Workbooks.Open(Filename)

wbsource.Sheets("result").Range("f8").Copy
wbdest.Sheets("data").Range("b4").PasteSpecial Paste:=xlPasteValues

 

[newyears]

As I said before

Sorry...yes column D always has data

 

[Fluff]

In that case change this line as shown

Destws.Range("[COLOR=#ff0000]D[/COLOR]" & Destws.Rows.Count).End(xlUp).Offset(1[COLOR=#ff0000],-3[/COLOR]).PasteSpecial xlPasteValues

 

[newyears]

In that case change this line as shown

Destws.Range("[COLOR=#ff0000]D[/COLOR]" & Destws.Rows.Count).End(xlUp).Offset(1[COLOR=#ff0000],-3[/COLOR]).PasteSpecial xlPasteValues

I was looking at putting in some error handling, and I haven't figured out why this is not working. If the user types a worksheet name (result) that is not on workbook, I want it to tell them and then have them enter again. The worksheet always have date numbers such as 020419 or 021119, etc

With Application
      Fname = .GetOpenFilename(, 3)
      result = InputBox("Enter worksheet name MMDDYY")
      If result = False Then
        MsgBox "sheet name does not exist"
        Exit Sub
      End If
   End With

 

[Fluff]

How about

Sub newyears()
   Dim Fname As String, Sht As String
   Dim Destws As Worksheet
   Dim Wbk As Workbook
   Dim i As Long
   
   Application.ScreenUpdating = False
   Sht = InputBox("Enter worksheet name MMDDYY")
   If Sht = "" Then
      MsgBox "You did not enter a sheet name"
      Exit Sub
   ElseIf Not Evaluate("isref('" & Sht & "'!A1)") Then
      MsgBox "Sheet name " & Sht & " does not exist"
      Exit Sub
   End If
   Set Destws = ThisWorkbook.Sheets(Sht)
   ChDrive ("C:")
   ChDir ("C:\Users\")
   With Application
      Fname = .GetOpenFilename(, 3)
   End With
   Set Wbk = Workbooks.Open(Fname)
   Wbk.Sheets(1).Rows("8:15").Copy
   Destws.Range("A1").PasteSpecial xlPasteValues
   For i = 2 To Wbk.Worksheets.Count
      Wbk.Worksheets(i).Rows("8:15").Copy
      Destws.Range("D" & Destws.Rows.Count).End(xlUp).Offset(1, -3).PasteSpecial xlPasteValues
   Next i
   Application.CutCopyMode = False
   Wbk.Close False
End Sub