Variable used in a range fails to increase while in a Do loop

Brock_Hardchest

New Member
Joined
Feb 23, 2018
Messages
27
Hello,

I am trying to transpose rows from one sheet to another sheet using a Do loop. I need it to move to the next row each time through the loop and place each transposed row in the new sheet 32 cells away from the other. The loop functions all the way through except it pastes the same transposed row over and over instead of moving on to the next row each time. Any help is appreciated. See below, thanks.

Code:
Sub Data()

Dim trangeQuantity As Range

bankrow = 3
newbankrow = 2
    
'Find the last non-blank cell in column A(1)
xrow = Cells(Rows.Count, 1).End(xlUp).Row


'Find the last non-blank cell in row 1
ycolumn = Cells(1, Columns.Count).End(xlToLeft).Column

Set trangeQuantity = Worksheets("Sheet1").Range(Cells(bankrow, 4), Cells(bankrow, ycolumn))

'adds new sheet
ActiveWorkbook.Sheets.Add.Name = "Data"

Do While bankrow <= xrow
    
    trangeQuantity.Copy
    
    Worksheets("Data").Cells(newbankrow, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False
    
    bankrow = bankrow + 1
    newbankrow = newbankrow + 32
    
Loop

End Sub
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
You set the value of for trangeQuantity outside of the loop, so it keeps taking the range you set it for.
 
Upvote 0
Does this work:

Code:
Sub Data()


Dim trangeQuantity As Range


bankrow = 3
newbankrow = 2
    
'Find the last non-blank cell in column A(1)
xrow = Cells(Rows.Count, 1).End(xlUp).Row




'Find the last non-blank cell in row 1
ycolumn = Cells(1, Columns.Count).End(xlToLeft).Column






'adds new sheet
ActiveWorkbook.Sheets.Add.Name = "Data"


Do While bankrow <= xrow
    Worksheets("Sheet1").Activate
    Set trangeQuantity = Worksheets("Sheet1").Range(Cells(bankrow, 4), Cells(bankrow, ycolumn))
    trangeQuantity.Copy
    
    Worksheets("Data").Cells(newbankrow, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False
    
    bankrow = bankrow + 1
    newbankrow = newbankrow + 32
    
Loop


End Sub
 
Upvote 0
Great. Thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,915
Members
448,532
Latest member
9Kimo3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top