Pulling Data from Multiple Sheets and Pasting it on Front Page VBA

[Unlucky-Phase]

Hello,

I currently have a workbook with multiple sheets and they all have the same table in them. But each table contains different information with different expiry dates. I'm trying to look for the info with an expiry date that matches 'my keydate' and paste it into the front page. There could be up to 15 different lines so obviously want them pasted consecutively. I'm having a couple issues, first is that I can only use one key date, whereas I'd like a range if possible (7 consecutive dates). If I put multiple key dates using OR it pulls the headers from each table and can be a little slow.
Also, it's pasting into the table 2 rows below the headers. I tried moving it up, but then it fails to find the last line which if why I've had to set a resize range and a clear contents. Here's my VBA code below:

Sub FindData()

totalsheets = Worksheets.Count

mykeyword = Worksheets("Front Page").Cells(7, 2).Value
Worksheets("Front Page").Range("D8:N500").ClearContents
Set objListObj = Worksheets("Front Page").ListObjects(1)
objListObj.Resize Range("D7:N9")

For i = 1 To totalsheets
    If Worksheets(i).Name <> "Front Page" Then
    lastrow = Worksheets(i).Cells(Rows.Count, 4).End(xlUp).Row
        For j = 1 To lastrow
        If Worksheets(i).Cells(j, 11).Value = mykeyword Then
        Worksheets("Front Page").Activate
        LastRow2 = Worksheets("Front Page").Cells(Rows.Count, 4).End(xlUp).Row + 1
        Worksheets("Front Page").Cells(LastRow2, 4).Value = Worksheets(i).Cells(j, 4).Value
        Worksheets("Front Page").Cells(LastRow2, 5).Value = Worksheets(i).Cells(j, 5).Value
        Worksheets("Front Page").Cells(LastRow2, 6).Value = Worksheets(i).Cells(j, 6).Value
        Worksheets("Front Page").Cells(LastRow2, 7).Value = Worksheets(i).Cells(j, 7).Value
        Worksheets("Front Page").Cells(LastRow2, 8).Value = Worksheets(i).Cells(j, 8).Value
        Worksheets("Front Page").Cells(LastRow2, 9).Value = Worksheets(i).Cells(j, 9).Value
        Worksheets("Front Page").Cells(LastRow2, 10).Value = Worksheets(i).Cells(j, 10).Value
        Worksheets("Front Page").Cells(LastRow2, 11).Value = Worksheets(i).Cells(j, 11).Value
        Worksheets("Front Page").Cells(LastRow2, 12).Value = Worksheets(i).Cells(j, 12).Value
        Worksheets("Front Page").Cells(LastRow2, 13).Value = Worksheets(i).Cells(j, 13).Value
        Worksheets("Front Page").Cells(LastRow2, 14).Value = Worksheets(i).Cells(j, 14).Value
         End If
        Next
    End If
Next
End Sub

Any help to optimise would be appreciated!

Thanks,

Molly

 

[NdNoviceHlp]

Not real sure about your requirements and/or your data layout but U can trial this. HTH. Dave

Option Explicit
Sub FindData()
Dim totalsheets As Integer, mykeyword As Date, objListObj As Object
Dim i As Integer, j As Integer, Lastrow As Integer, Lastrow2 As Integer
Dim DateArr() As Variant, Arrcnt As Integer
totalsheets = Worksheets.Count
mykeyword = CDate(Worksheets("Front Page").Cells(7, 2).Value)
ReDim DateArr(1)
DateArr = Array(mykeyword) 'load all dates in array here
Worksheets("Front Page").Range("D8:N500").ClearContents
Set objListObj = Worksheets("Front Page").ListObjects(1)
objListObj.Resize Range("D7:N9")
For i = 1 To totalsheets
    If Worksheets(i).Name <> "Front Page" Then
    With Worksheets(i)
    Lastrow = .Range("D" & .Rows.Count).End(xlUp).Row
    For j = 1 To Lastrow
    For Arrcnt = LBound(DateArr) To UBound(DateArr)
    If .Cells(j, 11).Value = DateArr(Arrcnt) Then
    'If .Cells(j, 11).Value = mykeyword Then
    'Worksheets("Front Page").Activate
    Lastrow2 = Worksheets("Front Page").Range("D" & Worksheets("Front Page").Rows.Count).End(xlUp).Row + 1
    Worksheets("Front Page").Cells(Lastrow2, 4).Value = .Cells(j, 4).Value
    Worksheets("Front Page").Cells(Lastrow2, 5).Value = .Cells(j, 5).Value
    Worksheets("Front Page").Cells(Lastrow2, 6).Value = .Cells(j, 6).Value
    Worksheets("Front Page").Cells(Lastrow2, 7).Value = .Cells(j, 7).Value
    Worksheets("Front Page").Cells(Lastrow2, 8).Value = .Cells(j, 8).Value
    Worksheets("Front Page").Cells(Lastrow2, 9).Value = .Cells(j, 9).Value
    Worksheets("Front Page").Cells(Lastrow2, 10).Value = .Cells(j, 10).Value
    Worksheets("Front Page").Cells(Lastrow2, 11).Value = .Cells(j, 11).Value
    Worksheets("Front Page").Cells(Lastrow2, 12).Value = .Cells(j, 12).Value
    Worksheets("Front Page").Cells(Lastrow2, 13).Value = .Cells(j, 13).Value
    Worksheets("Front Page").Cells(Lastrow2, 14).Value = .Cells(j, 14).Value
    End If
    Next Arrcnt
    Next j
    End With
    End If
Next i
End Sub