VBA Cut, Find and Past

iaindowner

New Member
Joined
Aug 12, 2014
Messages
18
I am trying to code an Active X command button to, upon clicking, Select a particular range on one work sheet, cut the contents and then past into the next blank column on another worksheet. Is anyone able to help with this?

Iain
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
I am trying to code an Active X command button to, upon clicking, Select a particular range on one work sheet, cut the contents and then past into the next blank column on another worksheet. Is anyone able to help with this?

Iain

Assume the range to cut is A2:Z50 on sheet 1 and the target sheet is sheet 2.
Code:
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets(1) 'Change to actual sheet name ie. Sheets("Data")
Set sh2 = Sheets(2) 'Change to actual sheet name
sh1.Range("A2:Z50").Cut sh2.Cells(Rows.Count, 1).End(xlUp)(2) 'Change "A2:Z50" to your target range.
End Sub
This code is written for an active-X command button. If the button is located on a worksheet, then the code should be copied to the worksheet code module by right clicking the sheet name tab. Then click 'View Code' in the pop up menu to open the sheet code window.
If you are using a MSO forms command button, then the code should be copied to the standard code module 1 by pressing Alt + F11 to open the VBE screen. The title line of the macro should also be modified to eliminate the word "Private" and substitute a different name for 'CommandButton1_Click'.
 
Upvote 0
.
.

Try this code for your command button:

Code:
Private Sub CommandButton1_Click()

    'For copy range:
    Dim CopyRange As Range
    Dim CopySizeX As Long
    Dim CopySizeY As Integer
    
    'For paste range:
    Dim PasteSheet As Worksheet
    Dim PasteRange As Range
    
    'For looping:
    Dim i As Integer
    
    'Prompt user for range to copy
SetCopyRange:
    On Error Resume Next
        Set CopyRange = Application.InputBox( _
            Prompt:="Select cell(s) to copy:", _
            Default:=ActiveWindow.RangeSelection.CurrentRegion.Address, _
            Type:=8)
    On Error GoTo 0
    
    'Exit if input box cancelled
    If CopyRange Is Nothing Then Exit Sub
    
    'If non-contiguous range selected
    If CopyRange.Areas.Count > 1 Then
        MsgBox _
            Prompt:="Selection must be contiguous.", _
            Buttons:=vbExclamation
        Set CopyRange = Nothing
        GoTo SetCopyRange
    End If
    
    'Determine size of CopyRange
    CopySizeX = CopyRange.Rows.Count
    CopySizeY = CopyRange.Columns.Count
    
    'Set sheet for pasting to.
    'Amend as necessary...
    Set PasteSheet = ThisWorkbook.Worksheets("Sheet2")
    
    With PasteSheet
        
        'Determine first empty column in PasteSheet
        For i = 1 To .Columns.Count
            If Application.WorksheetFunction.CountA(.Columns(i)) = 0 Then
                Exit For
            End If
        Next i
        
        'Set range for pasting to
        Set PasteRange = .Cells(1, i).Resize(CopySizeX, CopySizeY)
        
    End With
        
    'Paste CopyRange into PasteRange
    CopyRange.Copy Destination:=PasteRange
    CopyRange.ClearContents
    
    'Activate PasteSheet and
    'select PasteRange...
    
    PasteSheet.Activate
    PasteRange.Select
        
End Sub
 
Last edited:
Upvote 0
Assume the range to cut is A2:Z50 on sheet 1 and the target sheet is sheet 2.
Code:
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets(1) 'Change to actual sheet name ie. Sheets("Data")
Set sh2 = Sheets(2) 'Change to actual sheet name
sh1.Range("A2:Z50").Cut sh2.Cells(Rows.Count, 1).End(xlUp)(2) 'Change "A2:Z50" to your target range.
End Sub

This pastes the cut cells in column A in the uppermost blank cell. I want to take Values from I5:I22 on copy sheet and past into the first blank column in the paste sheet. e.g if column A (cell A1) isn't blank then paste in column B (cell B1)
 
Upvote 0
This pastes the cut cells in column A in the uppermost blank cell. I want to take Values from I5:I22 on copy sheet and past into the first blank column in the paste sheet. e.g if column A (cell A1) isn't blank then paste in column B (cell B1)


Iain,

Please try #3 and let me know if suitable...
 
Upvote 0
This pastes the cut cells in column A in the uppermost blank cell. I want to take Values from I5:I22 on copy sheet and past into the first blank column in the paste sheet. e.g if column A (cell A1) isn't blank then paste in column B (cell B1)

Modified to your specs.
Code:
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets(1) 'Change to actual sheet name ie. Sheets("Data")
Set sh2 = Sheets(2) 'Change to actual sheet name
sh1.Range("I5:I22").Cut sh2.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1) 
End Sub
Results are better and quicker when details are included in the original post.
 
Upvote 0
How to I paste values only without formatting.

This will only paste the values.
Code:
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets(1) 'Change to actual sheet name ie. Sheets("Data")
Set sh2 = Sheets(2) 'Change to actual sheet name
sh1.Range("I5:I22").Cut
sh2.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues 
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,549
Messages
6,114,261
Members
448,558
Latest member
aivin

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