Paste to the end of selected column

[Dtmq]

Hey everyone!
I'm new to VBA and have been attempting to achieve the following:

1. Message prompt let's the user select a cell from the column that is to be copied. Based on that cell, the entire column is copied.
2. The user then selects a cell from the column to which the copied column should be pasted. Here I don't want to overwrite any preexisting data and instead want the copied column to be pasted to the end of this column.

The code looks like this:

Sub test2()
Set ws1 = Sheets("Test Sheet 1")
Set ws2 = Sheets("Test Sheet 2")

  Dim rng As Range
  On Error Resume Next
  Set rng = Application.InputBox(Prompt:="Select a cell from the column that is to be copied .", Title:="Select Column", Type:=8)
  On Error GoTo 0
  If rng Is Nothing Then Exit Sub
  
  Dim rng2 As Range
  On Error Resume Next
  Set rng2 = Application.InputBox(Prompt:="Select a cell from the column in which the data should be pasted", Title:="Select column", Type:=8)
  Columns(rng.Column).Copy
[COLOR=rgb(251, 160, 38)]  ws2.Range(rng2.Columns & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues[/COLOR]
  Application.CutCopyMode = False

End Sub

I highlighted the line of code that I'm not getting to work as planned (in this current version, nothing is pasted). Any ideas? Help would be very much appreciated.

 

[Alex Blakenburg]

There are a number of issues with your code.

1. You can't copy a "whole" column to any position other that row 1 or it won't fit
   So you need to just select down the rows being used before copying.
2. Your On error resume next is masking errors
3. If you are copying between sheets you need to be referencing the sheets in the code.

See if the below helps:

Sub test2()

  Dim ws1 As Worksheet, ws2 As Worksheet

  Dim rng As Range
  On Error Resume Next
  Set rng = Application.InputBox(Prompt:="Select a cell from the column that is to be copied .", Title:="Select Column", Type:=8)
  Set ws1 = rng.Parent
  On Error GoTo 0
  If rng Is Nothing Then Exit Sub
  
  Dim rng2 As Range
  'On Error Resume Next
  Set rng2 = Application.InputBox(Prompt:="Select a cell from the column in which the data should be pasted", Title:="Select column", Type:=8)
  If rng2 Is Nothing Then Exit Sub
  Set ws2 = rng2.Parent
  'Columns(rng.Column).Copy
  With ws1
    .Range(.Cells(1, rng.Column), .Cells(Rows.Count, rng.Column).End(xlUp)).Copy
  End With
  ws2.Cells(Rows.Count, rng2.Column).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
  
  Application.CutCopyMode = False

End Sub

 

[Dtmq]

Hi, thank you vey much for you reply and help. From what I can see, the code now works as I had intended.

That makes sense. I was incorrectly assuming that only cells with entries would be counted as part of the column. I will have to look into the functionality of "On Error Resume Next", i found that in connection with the Application.InputBox when trying to create the message/selection boxes and didn't think much of it.

 

[Alex Blakenburg]

VBA does not always have the functionality to test if something exists and you have to use workarounds. One of the workarounds is to let it "error out" and then test for the error.
So you use On Error Resume Next to stop the code from crashing, then test for the error and perform the appropriate action. As soon as you have done that you want to turn error handling back on to a more appropriate setting.