Range Cut and paste using vba script

S

sreeinkorea

New Member
Joined
Sep 15, 2017
Messages
7
Hello,
I'm looking for a VBA script for the following scenario, kind request to suggest a method.

Ques:
I've a series of columns Range (A:HZ) (around 200 columns) with 10rows (fixed). I want to cut every 2 columns (following from C:D, E:F till HZ column) and concatenate the cut columns data below the first 2 columns (A:B) after 11th row(1 line space) and further paste other 2columns by leaving 1line space after every copy (beginning from 22nd row). Further move on towards right side of the remaining columns and keep concatenating below one after the other.


If any one can reply, then that shall reduce my editing time in excel and preparing the MS Word document.
Appreciate quick reply.
Thanking you.

Sorry i couldn't capture the snapshot or attach the file that I wanted to show, due to security reasons in my company.
I tried my best to create a table that I'm handling now, and the expected results as below.
[TABLE="width: 288"]
<colgroup><col width="72" span="4" style="width: 54pt;"></colgroup><tbody>[TR]
[TD="class: xl6977, width: 72"][/TD]
[TD="class: xl6981, width: 72"][/TD]
[TD="class: xl6977, width: 72"][/TD]
[TD="class: xl6981, width: 72"][/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 864"]
<colgroup><col width="72" span="6" style="width:54pt"> <col width="72" span="5" style="width:54pt"> <col width="72" style="width:54pt"> </colgroup><tbody>[TR]
[TD="class: xl6979, width: 72"]Attributes[/TD]
[TD="class: xl6983, width: 72"]Contents[/TD]
[TD="class: xl6979, width: 72"]Attributes[/TD]
[TD="class: xl6983, width: 72"]Contents[/TD]
[TD="class: xl6979, width: 72"]Attributes[/TD]
[TD="class: xl6983, width: 72"]Contents[/TD]
[TD="class: xl6979, width: 72"]Attributes[/TD]
[TD="class: xl6983, width: 72"]Contents[/TD]
[TD="class: xl6979, width: 72"]Attributes[/TD]
[TD="class: xl6983, width: 72"]Contents[/TD]
[TD="class: xl6979, width: 72"]Attributes[/TD]
[TD="class: xl6983, width: 72"]Contents[/TD]
[/TR]
[TR]
[TD="class: xl6979"]Requirement ID[/TD]
[TD="class: xl6983, width: 72"]1[/TD]
[TD="class: xl6979"]Requirement ID[/TD]
[TD="class: xl6983, width: 72"]2[/TD]
[TD="class: xl6979"]Requirement ID[/TD]
[TD="class: xl6983, width: 72"]3[/TD]
[TD="class: xl6979"]Requirement ID[/TD]
[TD="class: xl6983, width: 72"]4[/TD]
[TD="class: xl6979"]Requirement ID[/TD]
[TD="class: xl6983, width: 72"]5[/TD]
[TD="class: xl6979"]Requirement ID[/TD]
[TD="class: xl6983, width: 72"]6[/TD]
[/TR]
[TR]
[TD="class: xl6980, width: 72"]Requirements[/TD]
[TD="class: xl6984, width: 72"]abc[/TD]
[TD="class: xl6980, width: 72"]Requirements[/TD]
[TD="class: xl6984, width: 72"]abc[/TD]
[TD="class: xl6980, width: 72"]Requirements[/TD]
[TD="class: xl6984, width: 72"]abc[/TD]
[TD="class: xl6980, width: 72"]Requirements[/TD]
[TD="class: xl6984, width: 72"]abc[/TD]
[TD="class: xl6980, width: 72"]Requirements[/TD]
[TD="class: xl6984, width: 72"]abc[/TD]
[TD="class: xl6980, width: 72"]Requirements[/TD]
[TD="class: xl6984, width: 72"]abc[/TD]
[/TR]
[TR]
[TD="class: xl6981"]System State[/TD]
[TD="class: xl6984, width: 72"]Mode[/TD]
[TD="class: xl6981"]System State[/TD]
[TD="class: xl6984, width: 72"]Mode[/TD]
[TD="class: xl6981"]System State[/TD]
[TD="class: xl6984, width: 72"]Mode[/TD]
[TD="class: xl6981"]System State[/TD]
[TD="class: xl6984, width: 72"]Mode[/TD]
[TD="class: xl6981"]System State[/TD]
[TD="class: xl6984, width: 72"]Mode[/TD]
[TD="class: xl6981"]System State[/TD]
[TD="class: xl6984, width: 72"]Mode[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Rationale[/TD]
[TD="class: xl6984, width: 72"]SRS[/TD]
[TD="class: xl6981"]Rationale[/TD]
[TD="class: xl6984, width: 72"]SRS[/TD]
[TD="class: xl6981"]Rationale[/TD]
[TD="class: xl6984, width: 72"]SRS[/TD]
[TD="class: xl6981"]Rationale[/TD]
[TD="class: xl6984, width: 72"]SRS[/TD]
[TD="class: xl6981"]Rationale[/TD]
[TD="class: xl6984, width: 72"]SRS[/TD]
[TD="class: xl6981"]Rationale[/TD]
[TD="class: xl6984, width: 72"]SRS[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Priority[/TD]
[TD="class: xl6984, width: 72"]M1[/TD]
[TD="class: xl6981"]Priority[/TD]
[TD="class: xl6984, width: 72"]M1[/TD]
[TD="class: xl6981"]Priority[/TD]
[TD="class: xl6984, width: 72"]M1[/TD]
[TD="class: xl6981"]Priority[/TD]
[TD="class: xl6984, width: 72"]M2[/TD]
[TD="class: xl6981"]Priority[/TD]
[TD="class: xl6984, width: 72"]M3[/TD]
[TD="class: xl6981"]Priority[/TD]
[TD="class: xl6984, width: 72"]M3[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Risk[/TD]
[TD="class: xl6984, width: 72"]TBD[/TD]
[TD="class: xl6981"]Risk[/TD]
[TD="class: xl6984, width: 72"]TBD[/TD]
[TD="class: xl6981"]Risk[/TD]
[TD="class: xl6984, width: 72"]TBD[/TD]
[TD="class: xl6981"]Risk[/TD]
[TD="class: xl6984, width: 72"]TBD[/TD]
[TD="class: xl6981"]Risk[/TD]
[TD="class: xl6984, width: 72"]TBD[/TD]
[TD="class: xl6981"]Risk[/TD]
[TD="class: xl6984, width: 72"]TBD[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Related ID[/TD]
[TD="class: xl6985, width: 72"]TBD[/TD]
[TD="class: xl6981"]Related ID[/TD]
[TD="class: xl6985, width: 72"]TBD[/TD]
[TD="class: xl6981"]Related ID[/TD]
[TD="class: xl6985, width: 72"]TBD[/TD]
[TD="class: xl6981"]Related ID[/TD]
[TD="class: xl6985, width: 72"]TBD[/TD]
[TD="class: xl6981"]Related ID[/TD]
[TD="class: xl6985, width: 72"]TBD[/TD]
[TD="class: xl6981"]Related ID[/TD]
[TD="class: xl6985, width: 72"]TBD[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Status[/TD]
[TD="class: xl6986, width: 72"]NA[/TD]
[TD="class: xl6981"]Status[/TD]
[TD="class: xl6986, width: 72"]NA[/TD]
[TD="class: xl6981"]Status[/TD]
[TD="class: xl6986, width: 72"]NA[/TD]
[TD="class: xl6981"]Status[/TD]
[TD="class: xl6986, width: 72"]NA[/TD]
[TD="class: xl6981"]Status[/TD]
[TD="class: xl6986, width: 72"]NA[/TD]
[TD="class: xl6981"]Status[/TD]
[TD="class: xl6986, width: 72"]NA[/TD]
[/TR]
[TR]
[TD="class: xl6982"]Verification Criteria[/TD]
[TD="class: xl6987, width: 72"]TBD[/TD]
[TD="class: xl6982"]Verification Criteria[/TD]
[TD="class: xl6987, width: 72"]TBD[/TD]
[TD="class: xl6982"]Verification Criteria[/TD]
[TD="class: xl6987, width: 72"]TBD[/TD]
[TD="class: xl6982"]Verification Criteria[/TD]
[TD="class: xl6987, width: 72"]TBD[/TD]
[TD="class: xl6982"]Verification Criteria[/TD]
[TD="class: xl6987, width: 72"]TBD[/TD]
[TD="class: xl6982"]Verification Criteria[/TD]
[TD="class: xl6987, width: 72"]TBD[/TD]
[/TR]
</tbody>[/TABLE]



Expected Results
[TABLE="width: 144"]
<colgroup><col width="72" span="2" style="width:54pt"> </colgroup><tbody>[TR]
[TD="class: xl6979, width: 72"]Attributes[/TD]
[TD="class: xl6983, width: 72"]Contents[/TD]
[/TR]
[TR]
[TD="class: xl6979"]Requirement ID[/TD]
[TD="class: xl6983, width: 72"]2[/TD]
[/TR]
[TR]
[TD="class: xl6980, width: 72"]Requirements[/TD]
[TD="class: xl6984, width: 72"]abc[/TD]
[/TR]
[TR]
[TD="class: xl6981"]System State[/TD]
[TD="class: xl6984, width: 72"]Mode[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Rationale[/TD]
[TD="class: xl6984, width: 72"]SRS[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Priority[/TD]
[TD="class: xl6984, width: 72"]M1[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Risk[/TD]
[TD="class: xl6984, width: 72"]TBD[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Related ID[/TD]
[TD="class: xl6985, width: 72"]TBD[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Status[/TD]
[TD="class: xl6986, width: 72"]NA[/TD]
[/TR]
[TR]
[TD="class: xl6982"]Verification Criteria[/TD]
[TD="class: xl6987, width: 72"]TBD[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="class: xl6979"]Attributes[/TD]
[TD="class: xl6983, width: 72"]Contents[/TD]
[/TR]
[TR]
[TD="class: xl6979"]Requirement ID[/TD]
[TD="class: xl6983, width: 72"]3[/TD]
[/TR]
[TR]
[TD="class: xl6980, width: 72"]Requirements[/TD]
[TD="class: xl6984, width: 72"]abc[/TD]
[/TR]
[TR]
[TD="class: xl6981"]System State[/TD]
[TD="class: xl6984, width: 72"]Mode[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Rationale[/TD]
[TD="class: xl6984, width: 72"]SRS[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Priority[/TD]
[TD="class: xl6984, width: 72"]M1[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Risk[/TD]
[TD="class: xl6984, width: 72"]TBD[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Related ID[/TD]
[TD="class: xl6985, width: 72"]TBD[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Status[/TD]
[TD="class: xl6986, width: 72"]NA[/TD]
[/TR]
[TR]
[TD="class: xl6982"]Verification Criteria[/TD]
[TD="class: xl6987, width: 72"]TBD[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="class: xl6979"]Attributes[/TD]
[TD="class: xl6983, width: 72"]Contents[/TD]
[/TR]
[TR]
[TD="class: xl6979"]Requirement ID[/TD]
[TD="class: xl6983, width: 72"]4[/TD]
[/TR]
[TR]
[TD="class: xl6980, width: 72"]Requirements[/TD]
[TD="class: xl6984, width: 72"]abc[/TD]
[/TR]
[TR]
[TD="class: xl6981"]System State[/TD]
[TD="class: xl6984, width: 72"]Mode[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Rationale[/TD]
[TD="class: xl6984, width: 72"]SRS[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Priority[/TD]
[TD="class: xl6984, width: 72"]M2[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Risk[/TD]
[TD="class: xl6984, width: 72"]TBD[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Related ID[/TD]
[TD="class: xl6985, width: 72"]TBD[/TD]
[/TR]
[TR]
[TD="class: xl6981"]Status[/TD]
[TD="class: xl6986, width: 72"]NA[/TD]
[/TR]
[TR]
[TD="class: xl6982"]Verification Criteria[/TD]
[TD="class: xl6987, width: 72"]TBD[/TD]
[/TR]
</tbody>[/TABLE]


:
:
:
:

until all the columns towards right are concatenated one below the other with one line space after every copy.
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Sort by date Sort by votes
Try the code below.
Hope it helps.


Code: 
Dim aStartTime
Dim strFullName As String
Dim ProcName As String
Dim bErrorHandle As Boolean
Const DblSpace As String = vbNewLine & vbNewLine
Const CoName As String = "Job Done"


Sub Test()
    Dim rng As Range, aCell As Range
    Dim iRow As Long, iCol As Long, iMaxCol As Long, iNextRow As Long
    Dim cCells As Range
    
    On Error GoTo errHandler
    bErrorHandle = False
    
    '~~> Start Timer
    aStartTime = Now()
    
    '~~> Speeding Up VBA Code
    Call SpeedUp(False)
    
    '~~> Define variables
    Set rng = Range("A1:L10")
    iRow = rng(rng.Rows.Count, 1).Row
    iCol = 1
    iMaxCol = rng.Columns.Count
    
    '~~> Delete Old Entries
    Rows("12:" & Application.Max(12, iRow)).EntireRow.Delete
    
    '~~> Let's Loop Cut data
    For iCol = 1 To iMaxCol Step 2
        Set cCells = Range(Cells(1, iCol), Cells(iRow, iCol)).Resize(iRow, 2)
        Set aCell = Cells(Range("A" & Rows.Count).End(xlUp).Row + 2, 1)
        
        cCells.Cut aCell
        Application.CutCopyMode = False
        
    Next iCol
    
BeforeExit:
    
    '~~> Remove items from memory
    Set rng = Nothing
    Set cCells = Nothing
    Set aCell = Nothing
    
    '~~> Speeding Up VBA Code
    Call SpeedUp(True)
    
    If bErrorHandle = False Then
        MsgBox "Time taken: " & Format(Now() - aStartTime, "h:mm:ss") & vbNewLine _
            & DblSpace & " You're good to go!" & DblSpace & _
            CoName & Chr(32) & Chr(169) & Chr(32) & Year(Date), vbInformation, "Excellent"
    End If
    
    Exit Sub
errHandler:
    '~~> Error Occurred
    bErrorHandle = True
    ProcName = Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
    MsgBox "Procedure: - " & ProcName & DblSpace & Err.Description, vbCritical, "Oops I did it again...."
    Resume BeforeExit
    
End Sub



'#### SpeedUp (False) - Speeds the VBA Code #####
'#### SpeedUp (True) - Slows down the VBA Code ####
Public Function SpeedUp(Optional bSpeed As Boolean = True)
With Application
    .ScreenUpdating = bSpeed 'Prevent screen flickering
    .Calculation = IIf(bSpeed, xlAutomatic, xlCalculationManual) 'Preventing calculation
    .DisplayAlerts = bSpeed 'Turn OFF alerts
    .EnableEvents = bSpeed 'Prevent All Events
    '.Cursor = IIf(bSpeed, xlDefault, xlWait) 'Prevent Hour Glass
    '.StatusBar = IIf(bSpeed, vbNullString, "Please wait...")
End With
End Function
 
Last edited:
Upvote 0
Hello...
Thanks a ton, for such a wonderful piece of code... It worked exactly how I wanted to...

My apologies for the delayed reply. I really got held up with multiple tasks and couldn't reply.
Thanking you.
Sincerely,
Sree
 
Upvote 0
:)
Biz said:
Try the code below.
Hope it helps.


Code: 
Dim aStartTime
Dim strFullName As String
Dim ProcName As String
Dim bErrorHandle As Boolean
Const DblSpace As String = vbNewLine & vbNewLine
Const CoName As String = "Job Done"


Sub Test()
    Dim rng As Range, aCell As Range
    Dim iRow As Long, iCol As Long, iMaxCol As Long, iNextRow As Long
    Dim cCells As Range
    
    On Error GoTo errHandler
    bErrorHandle = False
    
    '~~> Start Timer
    aStartTime = Now()
    
    '~~> Speeding Up VBA Code
    Call SpeedUp(False)
    
    '~~> Define variables
    Set rng = Range("A1:L10")
    iRow = rng(rng.Rows.Count, 1).Row
    iCol = 1
    iMaxCol = rng.Columns.Count
    
    '~~> Delete Old Entries
    Rows("12:" & Application.Max(12, iRow)).EntireRow.Delete
    
    '~~> Let's Loop Cut data
    For iCol = 1 To iMaxCol Step 2
        Set cCells = Range(Cells(1, iCol), Cells(iRow, iCol)).Resize(iRow, 2)
        Set aCell = Cells(Range("A" & Rows.Count).End(xlUp).Row + 2, 1)
        
        cCells.Cut aCell
        Application.CutCopyMode = False
        
    Next iCol
    
BeforeExit:
    
    '~~> Remove items from memory
    Set rng = Nothing
    Set cCells = Nothing
    Set aCell = Nothing
    
    '~~> Speeding Up VBA Code
    Call SpeedUp(True)
    
    If bErrorHandle = False Then
        MsgBox "Time taken: " & Format(Now() - aStartTime, "h:mm:ss") & vbNewLine _
            & DblSpace & " You're good to go!" & DblSpace & _
            CoName & Chr(32) & Chr(169) & Chr(32) & Year(Date), vbInformation, "Excellent"
    End If
    
    Exit Sub
errHandler:
    '~~> Error Occurred
    bErrorHandle = True
    ProcName = Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
    MsgBox "Procedure: - " & ProcName & DblSpace & Err.Description, vbCritical, "Oops I did it again...."
    Resume BeforeExit
    
End Sub



'#### SpeedUp (False) - Speeds the VBA Code #####
'#### SpeedUp (True) - Slows down the VBA Code ####
Public Function SpeedUp(Optional bSpeed As Boolean = True)
With Application
    .ScreenUpdating = bSpeed 'Prevent screen flickering
    .Calculation = IIf(bSpeed, xlAutomatic, xlCalculationManual) 'Preventing calculation
    .DisplayAlerts = bSpeed 'Turn OFF alerts
    .EnableEvents = bSpeed 'Prevent All Events
    '.Cursor = IIf(bSpeed, xlDefault, xlWait) 'Prevent Hour Glass
    '.StatusBar = IIf(bSpeed, vbNullString, "Please wait...")
End With
End Function
Click to expand...
 
Upvote 0
sreeinkorea said:
Hello...
Thanks a ton, for such a wonderful piece of code... It worked exactly how I wanted to...

My apologies for the delayed reply. I really got held up with multiple tasks and couldn't reply.
Thanking you.
Sincerely,
Sree
Click to expand...

No problems, I'm glad it solved your problem.

Biz
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question Question
Join data from second worksheet with delimited list values (mults) to another worksheet with one value per cell/row and keep 1:1 relationship
Replies
2
Views
1K
HeadAgainstABrickWall
H
A
  • Question Question
Web Scraping using VBA
Replies
4
Views
9K
atr140
A
M
  • Question Question
Using VBA to return data before the last hyphen
2
Replies
11
Views
1K
mrpavlos
M
M
  • Question Question
extract-all-rows-from-a-range-that-meet-criteria-in-one-column-in-excel using vba
Replies
5
Views
9K
RasGhul
RasGhul
P
  • Question Question
Automate creating a worksheet adding rows based on certain criterias (all this in the same workbook)
Replies
1
Views
828
pratikjoshi448
P

Forum statistics

Threads
1,223,896
Messages
6,175,262
Members
452,627
Latest member
KitkatToby

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