Copy rows 2 by 2 at a time.

K

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 total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
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
mumps said:
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
Click to expand...
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
pjmorris said:
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
Click to expand...
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
pjmorris said:
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
Click to expand...
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
kevin9999 said:
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
Click to expand...
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
You must log in or register to reply here.

Similar threads

B
  • Question Question
VBA to insert rows based on cells column in another sheet (same workbook)
2 3
Replies
22
Views
747
Joe4
Joe4
M
  • Question Question
[VBA]Copy data from specify cell and input value to another sheet with time stamp
Replies
2
Views
444
maiwarits
M
D
  • Solved
VBA to copy only matching data from 2 csv workbooks into the "MasterCSV"
2
Replies
18
Views
949
Peter_SSs
Peter_SSs
D
  • Locked
  • Question Question
VBA to copy only matching data from 2 csv workbooks into the "Master Workbook"
Replies
1
Views
338
RoryA
RoryA
J
  • Solved
Copy Row x number of times from specific row and paste,shift down (VBA)
Replies
3
Views
391
MARK858
MARK858

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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