Solved: Loop Help

[SBrooky]

Hello
Im trying to figure out a loop that looks at worksheets (stored in an array TLName(1), TLName(2), TLName(3) etc.) at range A2 at first,

if A2 is blank then look at K2 (offset 0,10) until it has checked column EU
if A2 is NOT blank then copy A2:D2 to Sheets("Data Review").Range("F5:I5") ((next blank row again))
Then check if A3 is blank then copy A3:D3 to Sheets("Data Review") etc. until A(whatever row is blank) is blank.Also if its not blank:
I want it to put the sheet name (TLName(c)) in the F column on the Data Review sheet.
Find the sheet name (TLName(c)) in Sheets("Summary").Range("C:C") and return the value in D next to it.
from the TLName get the Value from A1 and put it in the C column of "Data Review". Or obviously if it has moved to K then K1 etc..Not clear I know. But im way over my depth here and this is my effort:
Option Explicit
Sub dataupdate()

Dim ws As Worksheet
Dim TLName(20) As String
Dim i, c, m, l As Integer

i = 1
l = 0
m = 0

For Each ws In ActiveWorkbook.Worksheets

If ws.Name = "Summary" Or _
ws.Name = "Actions Review" Or _
ws.Name = "Statistics" Or _
ws.Name = "Report" Or _
ws.Name = "TODO" Or _
ws.Name = "Data Review" _
Then i = i _
Else: TLName(i) = ws.Name

If ws.Name = "Summary" Or _
ws.Name = "Actions Review" Or _
ws.Name = "Statistics" Or _
ws.Name = "Report" Or _
ws.Name = "TODO" Or _
ws.Name = "Data Review" _
Then i = i _
Else: i = i + 1

Next ws


For c = 1 To i - 1
MsgBox TLName(c)

If ActiveWorkbook.Sheets(TLName(c)).Range("A2").Offset(l, m) = " " Then
l = 0
m = m + 10
Else
Worksheets("Data Review").Activate
Sheets("Data Review").Range("F4:i4").Offset(1, 0).End(xlDown) = Sheets(TLName(c)).Range("A2:D2").Offset(l, m).Value
MsgBox Sheets(TLName(c)).Range("A2").Offset(l, m).Value
l = l + 1

End If
Next c
End Sub


You guys have been awesome so far and I have learnt so much from this forum im very greatful.

[SBrooky]

Ive got a gallery of the different sheets to make it easier for anyone who is willing to help?

http://imgur.com/a/XGdGD

[Teeroy]

While the images helped a sample workbook with dummy data would have been much better.

The loop to feed the worksheets into an array that you loop through again was redundant; it can be done in one pass. I think the following will do what you are after.

Sub dataupdate()

Dim ws As Worksheet
Dim wsDataDest As Worksheet
Dim rTestCell As Range
Dim rPasteDest As Range
Dim lastRow As Long

Set wsDataDest = Worksheets("Data Review")
Set rPasteDest = wsDataDest.Range("F" & Rows.Count).End(xlUp).Offset(1, 0)
wsDataDest.Activate

For Each ws In ActiveWorkbook.Worksheets
If Not (ws.Name = "Summary" Or _
ws.Name = "Actions Review" Or _
ws.Name = "Statistics" Or _
ws.Name = "Report" Or _
ws.Name = "TODO" Or _
ws.Name = "Data Review") _
Then
Set rTestCell = ws.Range("A2")
lastRow = ws.UsedRange.Cells(ws.UsedRange.Rows.Count, 1).Row
Do
If rTestCell.Value = "" Then
Set rTestCell = rTestCell.Offset(0, 10)
If rTestCell.Column > 150 Then Exit Do
Else
Range(rTestCell, rTestCell.Offset(0, 4)).Copy rPasteDest
Set rPasteDest = rPasteDest.Offset(1, 0)
Set rTestCell = ws.Cells(rTestCell.Row + 1, 1)
End If
Loop Until rTestCell.Row > lastRow
End If
Next
End Sub

[SBrooky]

Perfect! Thanks alot. Thought this thread was dead so thanks for clicking through the next buttons for this =)