Help On Improving this Loop

[Manan]

Hi Masters,

Need a small help in improving this below loop as this is taking the lot of time , i think i have not coded it in nice way and the performance can still be improved. Any Help on below.

LoopI = 1
Rows_Data = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
Sheet2_Array_I = 1
 
Do While LoopI <= 32
Sheets("Data").Range("A" & Rows_Data).Copy
Sheets("Sheet2_Array").Range("A" & Sheet2_Array_I).PasteSpecial Paste:=xlPasteValues
Sheets("Data").Range("B" & Rows_Data).Copy
Sheets("Sheet2_Array").Range("B" & Sheet2_Array_I).PasteSpecial Paste:=xlPasteValues
Sheets("Data").Range("C" & Rows_Data).Copy
Sheets("Sheet2_Array").Range("C" & Sheet2_Array_I).PasteSpecial Paste:=xlPasteValues
Sheets("Data").Range("D" & Rows_Data).Copy
Sheets("Sheet2_Array").Range("D" & Sheet2_Array_I).PasteSpecial Paste:=xlPasteValues
Sheets("Data").Range("E" & Rows_Data).Copy
Sheets("Sheet2_Array").Range("E" & Sheet2_Array_I).PasteSpecial Paste:=xlPasteValues
LoopI = LoopI + 1
Sheet2_Array_I = Sheet2_Array_I + 1
Loop

 

[Hui]

Does the following achieve the same result without a loop

Sheets("Data").Select
Rows_Data = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
Range(Cells(Rows_Data, 1), Cells(Rows_Data, 5)).Copy
Sheets("Sheet2_Array").Select
Range(Cells(1, 1), Cells(32, 5)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False

 

[Manan]

Hi Hui,
Thanks for reply , but the solution does not achieves the same result. What i am trying to achieve is that it should copy the 32 rows from Sheet "DATA" to Sheet "Sheet2_Array" for Columns A, B , C , D, E . But the above code is Copying only one row from Sheet "DATA" and Pasting same values to Sheet "Sheet2_Array" for 32 times.

Can you please guide me on this how to achieve it faster as the loop that i have created is very time taking .

Thanks,
Manan.

 

[Hui]

Can you please post a file with data in the source and destination