Nested for Loop

[Arae97]

I can't seem to figure out how to jump to the next "c" in the loop after pasting my data. it works the first time but does not return to the first loop to change the c value to continue the process. any help would be great

Sub CopyPasteData()
Dim Pool As Worksheet
Dim Family As Range
Dim i As Integer
Dim Finalrow As Integer
Dim c As Variant
Set Pool = Sheet1
Set Family = Pool.Range("R2:R16")
Pool.Select
Finalrow = Cells(Rows.Count, 1).End(xlUp).Row


For Each c In Family


For i = 2 To Finalrow
If Cells(i, 1) = c.Value Then
Range(Cells(i, 2), Cells(i, 13)).Copy
Sheets(c.Value).Select
Range("a3").End(xlToRight).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Pool.Select
End If
Exit For

Next c


End Sub
[/code]

 

[Fluff]

@Steve_
Please do not quote posts in full as it just clutters up the thread.

 

[Fluff]

If the msgbox only appeared once, then there is something else going on.
Is the code in post#5 your EXACT code, or have you taken bits out?
Also when stepping through the code with F8 does any other code run?

 

[Arae97]

Sub CopyPasteData()
Dim i As Integer, c As Variant
Dim Pool As Worksheet
Set Pool = Sheet1
ThisWorkbook.Sheets("Pool").Activate
For Each c In Pool.Range("R2:R16")
For i = 2 To Pool.UsedRange.Rows.Count
If Cells(i, 1) = c.Value Then
Range(Cells(i, 2), Cells(i, 13)).Copy
Sheets(c.Value).Select
Range("a3").End(xlToRight).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sheets("Pool").Activate
Exit For
End If
Next i
Next c
End Sub
@Steve_
I modified you suggestion and it is seeming to work. But how would I or where would I add an If Error or a go to next if the c.value cannot be found in the used range.

 

[Arae97]

@Fluff

It is my exact code. and no other code runs. that is why i seemed to be stumped. the code from steve seems to work but is a little slow. but as long as the query works.

 

[Fluff]

In that case I've no idea why it's not working, but does this do what you need?

Sub Area97()
   Dim ary As Variant
   Dim i As Long
   
   With Sheet1
      ary = .Range("R2:R16").Value2
      For i = 1 To UBound(ary)
         If ary(i, 1) <> "" Then
            .Range("A1:M1").AutoFilter 1, ary(i, 1)
            .AutoFilter.Range.Offset(1, 1).Copy
            Sheets(ary(i, 1)).Range("A3").End(xlToRight).Offset(, 1).PasteSpecial xlPasteValues, , , True
         End If
      Next i
      .AutoFilterMode = False
   End With
End Sub