Macro To Loop From Last Row To Row 4

[clattenburg cake]

I have two sheets, "Database" and "TeamSheet". I need to get certain data from a team in "Database" and paste it into "TeamSheet". The criteria for this data is obtained from "TeamSheet", it looks up the last active row from that sheet and finds the required data from "Database". My problem is that I don't just want the data for the last row, I want it to loop from the last row right up until row 4. Here is my code so far (which only applies to the last row):

Sub futboldata()

Dim rngC As Range
Dim rngJ As Range
Dim rngL As Range
Dim rngP As Range
Dim rngQ As Range
Dim rngT As Range
Dim rngU As Range
Dim rngW As Range
Dim rngX As Range
Dim lngCounter As Long

Workbooks("TeamSheet").Activate
Sheets("Team1").Activate
lngCounter = Cells.Find("*", [A1], , , xlByRows, xlPrevious).row

Set rngC = Range("C" & rows.Count).End(xlUp)

Set rngT = Range("T" & lngCounter)

Set rngU = Range("U" & lngCounter)

Set rngW = Range("W" & lngCounter)

Set rngX = Range("X" & lngCounter)


Workbooks("Database").Activate
Sheets("Team1").Activate


Set rngJ = Range("J" & rows.Count).End(xlUp)

Set rngL = Range("L" & rows.Count).End(xlUp)

Set rngP = Range("P" & rows.Count).End(xlUp)

Set rngQ = Range("Q" & rows.Count).End(xlUp)

'Filter by opposition team, and whether target team played at home (H) or away (A)
With Workbooks("Database").Sheets("Team1")
If .FilterMode Then .ShowAllData
With .Range("A7", .Range("A" & .rows.Count).End(xlUp)).Resize(, 12)
            .AutoFilter Field:=2, Criteria1:=rngC               'C
            .AutoFilter Field:=3, Criteria1:=rngC.Offset(, 2)   'E
End With
End With
      
rngJ.Copy
Workbooks("TeamSheet").Sheets("Team1").Activate
rngT.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

rngL.Copy
rngU.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

rngP.Copy
rngW.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
rngQ.Copy
rngX.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End Sub

Can anyone help?

[arlu1201]

It will be good if you explain your requirement a little more and maybe even attach a sample file so we can test on it.

To Attach a File:

1. Click on Go Advanced
2. In the frame Attach Files you will see the button Manage Attachments
3. Click the button.
4. A new window will open titled Manage Attachments - Excel Forum.
5. Click the Browse... button to locate your file for uploading.
6. This will open a new window File Upload.
7. Once you have located the file to upload click the Open button. This window will close.
8. You are now back in the Manage Attachments - Excel Forum window.
9. Click the Upload button and wait until the file has uploaded.
10. Close the window and then click Submit.

[clattenburg cake]

Attachment 250334Attachment 250335Sure, I've attached the two workbooks. I need to get data from "Database Test" into "Blank Team Sheet". The team I'm trying to copy the data for at the moment is Fulham- there are only three games but my code is only able to look up the last game (v Arsenal) and get info for that from "Database Test". The data I am looking for specifically are Total Shots, Shots on Target, Shots OFf Target, Total Home Corners and Total Away Corners. These will be filled into "Blank Team Sheet" based on the data from "Database Test".

Eventually the goal will be to loop through all the teams and fill the blanks for all the matches...