Copy rows 2 by 2 at a time.

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,648
Office Version
  1. 2010
Platform
  1. Windows
Using Excel 2000

Hi,

My data are set in cells A6:V19 total 14 rows. I want to copy 2 rows at a time and paste them from A30 to down after every 2 row need 1 space for next copy….

For example A6:V7 “2 rows” want to copy in A30:V31 then one empty row, next A7:V8 “2 rows” want to copy in A33:V34 and so on….last rows will be the A18:V19

Example sheet attached…..

NX.xls
ABCDEFGHIJKLMNOPQRSTUVWXY
1
2
3
4
5SeriolP1P2P3P4P5P6P7P8P9P10P11P12P13P14P15P16P17P18P19P20P21EMP1P2
61N.X1N.XN.X1N.XN.XN.XN.X1N.XN.XN.XN.XN.XN.XN.XN.XN.X
72N.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.X
83N.XN.XN.XN.X12N.XN.XN.XN.XN.XN.XN.XN.X1N.X1N.XN.X
94N.XN.XN.XN.XN.X12N.XN.XN.XN.X1N.XN.XN.X12N.X1
105N.XN.XN.XN.XN.XN.XN.XN.X1N.XN.XN.X1234N.XN.XN.X
116N.XN.XN.XN.X1N.X1N.XN.XN.XN.XN.X1N.XN.XN.XN.XN.XN.X
1271N.XN.X1N.XN.XN.XN.XN.XN.X12N.XN.X1N.XN.XN.XN.X
1381N.XN.XN.XN.XN.XN.X1N.XN.XN.XN.XN.XN.XN.XN.XN.X1N.X
149N.XN.XN.XN.XN.XN.XN.XN.XN.X1N.X1N.XN.XN.XN.XN.XN.X1
1510N.X1N.XN.X1N.XN.XN.XN.X12N.XN.X1N.XN.XN.X1N.X
16111N.XN.X12N.XN.XN.XN.XN.XN.XN.XN.XN.X12N.XN.XN.X
171212N.XN.X12N.XN.XN.XN.XN.XN.X1N.XN.X12N.XN.X
18131N.XN.XN.X1N.XN.X1N.XN.X123N.X1N.X1N.X1
1914N.X1N.XN.XN.X1N.X123N.X123N.X1N.XN.XN.X
20
21
22
23
24
25
26
27
28
29SeriolP1P2P3P4P5P6P7P8P9P10P11P12P13P14P15P16P17P18P19P20P21EMP1P2
301N.X1N.XN.X1N.XN.XN.XN.X1N.XN.XN.XN.XN.XN.XN.XN.XN.X
312N.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.X
32
332N.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.XN.X
343N.XN.XN.XN.X12N.XN.XN.XN.XN.XN.XN.XN.X1N.X1N.XN.X
35
363N.XN.XN.XN.X12N.XN.XN.XN.XN.XN.XN.XN.X1N.X1N.XN.X
374N.XN.XN.XN.XN.X12N.XN.XN.XN.X1N.XN.XN.X12N.X1
Hoja7


Thank you in advance

Regards,
Kishan
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Try:
VBA Code:
Sub CopyRows()
    Application.ScreenUpdating = False
    Dim x As Long
    For x = 6 To 19
        Cells(Rows.Count, "A").End(xlUp).Offset(2).Resize(2, 22).Value(11) = Range("A" & x).Resize(2, 22).Value(11)
    Next x
    Rows(30).Delete
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Put this in Cell A30 and copy down and across as necessary:

Excel Formula:
=IF(MOD(ROW(),3)=2,"",OFFSET(A$6,MOD(ROW(),3)+2*INT((ROW()-30)/3),0))

HTH
 
Upvote 0
Try:
VBA Code:
Sub CopyRows()
    Application.ScreenUpdating = False
    Dim x As Long
    For x = 6 To 19
        Cells(Rows.Count, "A").End(xlUp).Offset(2).Resize(2, 22).Value(11) = Range("A" & x).Resize(2, 22).Value(11)
    Next x
    Rows(30).Delete
    Application.ScreenUpdating = True
End Sub
Hello mumps. Macro works…please can you check? 2 things 1-every time I run macro it copy’s next to last rows I need always copy must be in the same range. 2- While copying it start from row 31 and after macro finish it deletes row 30 which is affection my right data columns.

Good Luck.

My Best Regards
Kishan
 
Upvote 0
Put this in Cell A30 and copy down and across as necessary:

Excel Formula:
=IF(MOD(ROW(),3)=2,"",OFFSET(A$6,MOD(ROW(),3)+2*INT((ROW()-30)/3),0))

HTH
Hello pjmorris. I tried the formula not bed idea but your formula copy 1&2, 3&4, 5&6…I need to copy 1&2, 2&3, 3&4….so on.

I prefer macro if you can do it. I like can also can you make modify formula too.


Good Luck.

My Best Regards
Kishan
 
Upvote 0
Hi Krishnan,

Again, place in A30 and copy across and down as necessary.

Excel Formula:
=IF(MOD(ROW(),3)=2,"",OFFSET(A6,-2*INT((ROW()-30)/3),0))

I'll leave the VBA version to MUMPS!

Regards
 
Upvote 1
Hi Krishnan,

Again, place in A30 and copy across and down as necessary.

Excel Formula:
=IF(MOD(ROW(),3)=2,"",OFFSET(A6,-2*INT((ROW()-30)/3),0))

I'll leave the VBA version to MUMPS!

Regards
Hello pjmorris. Yes this formula worked fine giving the correct results as request. Thank you so much for your help and time.

Now waiting someone help with VBA version I find bit easier working with large data ranges.

Good Luck.

My Best Regards
Kishan :)
 
Upvote 0
Another option?
VBA Code:
Option Explicit
Sub Kishan()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Hoja7")
    ws.Range("A5:V7").Copy ws.Range("A29")
    
    Dim a, b, i As Long, j As Long, k As Long
    a = ws.Range("A7:V19")
    ReDim b(1 To (UBound(a, 1) * 3), 1 To UBound(a, 2))
    
    i = 1: k = 1
    Do While i < UBound(a, 1)
        For j = 1 To UBound(a, 2)
            b(k, j) = a(i, j)
        Next j
        i = i + 1: k = k + 1
        For j = 1 To UBound(a, 2)
            b(k, j) = a(i, j)
        Next j
        k = k + 2
    Loop
    ws.Range("A33").Resize(UBound(b, 1), UBound(b, 2)).Value = b
    
    With ws.Range("A30:V31")
        .Copy
        For i = 33 To 66 Step 3
            ws.Cells(i, 1).PasteSpecial xlPasteFormats
        Next i
        Application.CutCopyMode = False
    End With   
    Application.ScreenUpdating = True
End Sub
 
Upvote 1
Solution
Another option?
VBA Code:
Option Explicit
Sub Kishan()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = Worksheets("Hoja7")
    ws.Range("A5:V7").Copy ws.Range("A29")
   
    Dim a, b, i As Long, j As Long, k As Long
    a = ws.Range("A7:V19")
    ReDim b(1 To (UBound(a, 1) * 3), 1 To UBound(a, 2))
   
    i = 1: k = 1
    Do While i < UBound(a, 1)
        For j = 1 To UBound(a, 2)
            b(k, j) = a(i, j)
        Next j
        i = i + 1: k = k + 1
        For j = 1 To UBound(a, 2)
            b(k, j) = a(i, j)
        Next j
        k = k + 2
    Loop
    ws.Range("A33").Resize(UBound(b, 1), UBound(b, 2)).Value = b
   
    With ws.Range("A30:V31")
        .Copy
        For i = 33 To 66 Step 3
            ws.Cells(i, 1).PasteSpecial xlPasteFormats
        Next i
        Application.CutCopyMode = False
    End With  
    Application.ScreenUpdating = True
End Sub
Hello kevin9999, your code is magical; you have taken care of every single point. First step it copy the header than copy rows 2 in 2 finally it copy as it is per original data format is it more perfect the expectations I like the macro very much. It is just perfect! 🙌

I appreciate your time and thank you for solving my query. 🤝

Good Luck.

My Best Regards
Kishan :)
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,287
Members
452,631
Latest member
a_potato

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