Double Loop To Copy And Paste

albatros81 · May 18th 2007

Hi,

i have this code

Code

Dim UltFila As Long, i As Integer, k As Integer
        UltFila = Range("A65536").End(xlUp).Row
        k = 2
        For i = UltFila To 2 Step -1
            If Cells(i, 2) = 4102 Then
            Range(Cells(i, 3), Cells(i + 15, 6)).Copy Sheets("Final").Cells(k, 1)
            End If
            If Cells(i, 2) = 4104 Then
            Range(Cells(i, 3), Cells(i + 15, 6)).Copy Sheets("Final").Cells(k, 1)
            End If
            If Cells(i, 2) = 4106 Then
            Range(Cells(i, 3), Cells(i + 15, 6)).Copy Sheets("Final").Cells(k, 1)
            End If
            If Cells(i, 2) = 4108 Then
            Range(Cells(i, 3), Cells(i + 15, 6)).Copy Sheets("Final").Cells(k, 1)
            End If
            If Cells(i, 2) = 4147 Then
            Range(Cells(i, 3), Cells(i + 15, 6)).Copy Sheets("Final").Cells(k, 1)
            End If
            If Cells(i, 2) = 4110 Then
            Range(Cells(i, 3), Cells(i + 15, 6)).Copy Sheets("Final").Cells(k, 1)
            End If
            If Cells(i, 2) = 4258 Then
            Range(Cells(i, 3), Cells(i + 15, 6)).Copy Sheets("Final").Cells(k, 1)
            End If
            If Cells(i, 2) = 4153 Then
            Range(Cells(i, 3), Cells(i + 15, 6)).Copy Sheets("Final").Cells(k, 1)
            End If
            
        Next i

Display More

i want to make a loop for the destination of the copy that starts in k = 2, as you have seen, and the step = 19... i have trying with different code, and putting the "for" loop in different places of this sentences, but it's impossible...

Anybody could help me???

Also, if somebody see that could make my code more easy, i would be very pleasant...

filo65 · May 18th 2007

Re: Double Loop To Copy And Paste

try

Code

Sub myloop()
  Dim UltFila As Long, i As Long, k As Long
  UltFila = Range("A65536").End(xlUp).Row
  k = 2
  For i = 2 To UltFila Step 1
    Select Case Cells(i, 2)
      Case 4102, 4104, 4106, 4108, 4147, 4110, 4258, 4153
        Range(Cells(i, 3), Cells(i + 15, 6)).Copy Sheets("Final").Cells(k, 1)
      Case Else
      'do nothing
    End Select
    k = k + 19
  Next i
End Sub

Display More

filippo

albatros81 · May 18th 2007

Re: Double Loop To Copy And Paste

it doesn't work as i want, but thank you for your effort... your code only copy the rows that belong to 4258, which is the last reference...

i need a code that could copy the first 16 rows that belong to every reference (4102,4104,4106......) to the sheet called final... making a loop in the copy and in the paste... because maybe, in the future, i can add some references, and i need to not fix the row where i want to paste...

the easy option i managed was putting in the destination the cell i want, but, maybe every month i have to change the cell and the references... so it's a bit unefficient

filo65 · May 18th 2007

Re: Double Loop To Copy And Paste

just to avoid misunderstandings, could you psot a scracth of your workbook?

filippo

albatros81 · May 18th 2007

Re: Double Loop To Copy And Paste

Here you have the first sheet where i have to extract the data to copy to the sheet "final"

filo65 · May 18th 2007

Re: Double Loop To Copy And Paste

albatros81,

in your file portfolio 4102 has 21 entries, 4104 has 24, etc. Is there a special reason to choose the first 16? What exactly do you mean with

Quote

step = 19

?

what exactly would you like to do? is it the total exposure for issuer?

filippo

albatros81 · May 18th 2007

Re: Double Loop To Copy And Paste

I choose the first 16th because are the most representative of the reference... i have attached a little part of the real sheet. The real sheet has 2200 rows aprox... you can see also a reference (4341) that it's not included in the "final", because only have 3 rows (here, in the little attached, only appear one)...

i need to step 19 because the first 16th rows are for the paste, the 17th is for a sum of % that are >5% of every reference, and the other is for a blank row...

filo65 · May 18th 2007

Re: Double Loop To Copy And Paste

I think I got it

Code

Sub myloop()
  Dim UltFila As Long, i As Long, k As Long, imax&
  Dim myRng As Range
  UltFila = Range("A65536").End(xlUp).Row
  Set myRng = Range("B2:B" & UltFila)
  k = 2
  For i = 2 To UltFila Step 1
    imax = Application.WorksheetFunction.CountIf(myRng, "=" & Cells(i, 2))
    Select Case Cells(i, 2)
      Case 4102, 4104, 4106, 4108, 4147, 4110, 4258, 4153
        Range(Cells(i, 3), Cells(i + 15, 6)).Copy Sheets("Final").Cells(k, 1)
        k = k + 19
        i = i + imax - 1
      Case Else
      'do nothing
    End Select
  Next i
End Sub

Display More

filippo

albatros81 · May 18th 2007

Re: Double Loop To Copy And Paste

you got it, yeah! fantastic man!

but, to be honest, it's different to my original result... because, you can see that the reference 4153 is the last for me, and for you appears after the reference 4104... i know that i can sort it after apply your code or copy/paste to the last row... but your code is more efficient than mine, so... could you make your code sort as i want directly?

or, would you do after your code... sorting or copy/paste? Because, in this case, i could do this also without any problem, and i don't want to annoy you...

what do you think about?

filo65 · May 18th 2007

Re: Double Loop To Copy And Paste

OK, let's try this one

Code

Sub myloop_new()
  Dim UltFila As Long, i As Long, k As Long, imax&, tmp&, j&
  Dim myRng As Range, myArray As Variant
  Dim refRow&
  UltFila = Range("A65536").End(xlUp).Row
  Set myRng = Range("B1:B" & UltFila)
  myArray = Array(4102, 4104, 4106, 4108, 4147, 4110, 4153, 4258)
  k = 2:  j = 0
  For i = 0 To UBound(myArray, 1) Step 1
    tmp = myArray(j)
    refRow = myRng.Find(what:=tmp).Row
    imax = Application.WorksheetFunction.CountIf(myRng, "=" & tmp)
    If imax >= 16 Then
      Select Case tmp
        Case 4102, 4104, 4106, 4108, 4147, 4110, 4153, 4258
          Range(Cells(refRow, 3), Cells(refRow + 15, 6)).Copy Sheets("Final").Cells(k, 1)
          k = k + 19:  j = j + 1
          If j > UBound(myArray, 1) Then Exit For
        Case Else
        'do nothing
      End Select
    End If
  Next i
End Sub

Display More

filippo

albatros81 · May 18th 2007

Re: Double Loop To Copy And Paste

incredible...

it works in the way i wanted... i think i have to study a little more to do this kind of things...

fantastic filippo... and thanks again for all... you're great!

Double Loop To Copy And Paste

Participate now!

Share