VBA Cut, Find and Past

[iaindowner]

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

 

[JLGWhiz]

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.

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'.

 

[ParamRay]

.
.

Try this code for your command button:

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

 

[iaindowner]

Assume the range to cut is A2:Z50 on sheet 1 and the target sheet is sheet 2.

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)

 

[ParamRay]

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...

 

[JLGWhiz]

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.

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.

 

[iaindowner]

This works perfectly thank you. How to I paste values only without formatting.

 

[JLGWhiz]

How to I paste values only without formatting.

This will only paste the values.

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