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 can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
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

A
  • Solved
Formulas and relative pointing
2
Replies
15
Views
464
atrainwreck
A
C
  • Question
Macro that changes cell after each copy and paste
2
Replies
11
Views
420
PeteWright
PeteWright
C
  • Question
Compare cells in rows from 2 differents sheets before copy
2
Replies
15
Views
350
Tupe77
T
B
  • Question
Copying Data from Sheet 1 to Sheet 2 and adding rows- Code Needed
2 3 4
Replies
30
Views
845
mumps
mumps
A
  • Question
Dynamically add new rows via VBA when using IFERROR TEXTJOIN and FILTER formulas from Table?
Replies
0
Views
93
AlfredDB
A

Forum statistics

Threads
1,215,165
Messages
6,123,391
Members
449,098
Latest member
ArturS75

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