Copy and paste values in different cells

[ychin130]

Hi,

I'm trying to copy the A1 value to the A2 cell and clear the content of A1, and copy the B1 value and paste it A3, the # rows may increase and I can have more rows. I havent been able to get to the expected result.

Any help is appreciated?

A	B
Total Federal Work Opportunity Tax Credits Earned to Date: $100,000.00	Less: Credits Previously Invoiced: $75,000.00
Total Federal Work Opportunity Tax Credits Earned to Date: $100,000.00	Less: Credits Previously Invoiced: $85,000.00

Expected result

A	B
	Less: Credits Previously Invoiced: $75,000.00
Total Federal Work Opportunity Tax Credits Earned to Date: $100,000.00
Less: Credits Previously Invoiced: $75,000.00
	Less: Credits Previously Invoiced: $85,000.00
Total Federal Work Opportunity Tax Credits Earned to Date: $100,000.00
Less: Credits Previously Invoiced: $85,000.00

 

[offthelip]

try this code, it is very fast because it uses variant arrays.

Sub test()
Dim outarr()
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(lastrow, 2))
ReDim outarr(1 To 2 + lastrow * 3, 1 To 2)
indi = 2
For i = 1 To lastrow - 1
  outarr(indi, 2) = inarr(i, 2) ' copy B2 to B2
  indi = indi + 1
  outarr(indi, 1) = inarr(i, 1)  ' copy A1 to A2
  indi = indi + 1
  outarr(indi, 1) = inarr(i, 2) ' copy B2 to A3
  indi = indi + 1
Next i
 Range(Cells(1, 1), Cells(2 + lastrow * 3, 2)) = outarr
 
End Sub