Hiya,

I have been using the below code for a while and it works perfectly
but I am currently trying to refine it for other projects and am
struggling...

The only part missing is the ability to choose exactly which rows have
data in them and only transfer those. I have managed to do this in
various different ways but I need it to ignore each header row (row
1), as some of the data sources have only a couple of lines of data
with a heading. I have found different ways of doing it that don't
seem to work with my below code.

Private Sub cmdImport2_Click()
On Error GoTo Err_CommandButton1_Click

Application.DisplayAlerts = False
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim i As Long
Dim a As Long
Dim s$
Dim rng As Range

Application.ScreenUpdating = False

With Application.FileSearch
.NewSearch
.LookIn = InputBox("Please amend the folder name as
appropriate using the following format as an example" & Chr(13) &
Chr(13) & "F:\APRD SHARED FOLDER\STATS", "Enter File Path", "")
.FileName = "*Maritime*.xls"
.MatchTextExactly = False


.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set basebook = ThisWorkbook
rnum = 2
For i = 1 To .FoundFiles.Count

Set mybook = Workbooks.Open(.FoundFiles(i))
Application.AskToUpdateLinks = False

Err.Clear
On Error Resume Next

Set sourceRange = Sheets("Data").Range("A2:BP50")
a = sourceRange.Rows.Count

If Err < 0 Then
'Sheets("Data") doesn't exist
Set sourceRange = Sheets("Other Data").Row("2:50")
a = sourceRange.Rows.Count
Set sourceRange = Sheets("Insert other tab name
here").Range("a2:k336")
a = sourceRange.Rows.Count
a = sourceRange.Rows.Count
Set sourceRange = Sheets("Insert other tab name
here2").Range("a2:k336")
a = sourceRange.Rows.Count
End If
On Error GoTo 0
Err.Clear

With sourceRange

Set destrange = basebook.Worksheets(2).Cells(rnum,
1). _
Resize(.Rows.Count, .Columns.Count)

End With
destrange.Value = sourceRange.Value
mybook.Close SaveChanges:=False
rnum = i * a + 1
Next i
End If
End With

Application.ScreenUpdating = True

Exit_CommandButton1_Click:
Exit Sub

Err_CommandButton1_Click:
'MsgBox Err.Description
Resume Exit_CommandButton1_Click
End Sub