Trying to copy multiple columns into one (specific) column

[sheri23110]

Zero VBA knowledge here. This code was found via a google search. After changing a few things, it does everything I need it to do with one exception:

I want to copy the data to a specific column. Currently the code copies the data into column A. I want to be able to specify the column.

Thank you for taking the time to help, and if there is an easier way to do this other than what is outlined below, please let me know.

Sub CopyColumnsToOneColumn()
Dim sourceSheet As Worksheet
Dim destinationSheet As Worksheet
Dim lastRow As Long
Dim destRow As Long
Dim col As Long
Dim i As Long

' Set your source and destination sheets
Set sourceSheet = ThisWorkbook.Sheets("testdata")
Set destinationSheet = ThisWorkbook.Sheets("test")

' Initialize the destination row
destRow = 2

' Loop through each column you want to copy
For col = 1 To 4 ' Adjust the range (1 To 4) to the columns you want to copy
' Find the last row in the current column
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, col).End(xlUp).Row

' Copy each cell from the current column to the destination column
For i = 2 To lastRow
destinationSheet.Cells(destRow, 1).Value = sourceSheet.Cells(i, col).Value
destRow = destRow + 1
Next i

Next col

MsgBox "Columns copied successfully!"
End Sub

 

[kvsrinivasamurthy]

Your code modified to select the destination column name.

Sub CopyColumnsToOneColumn()
Dim sourceSheet As Worksheet
Dim destinationSheet As Worksheet
Dim lastRow As Long
Dim destRow As Long
Dim destColumn As String
Dim col As Long
Dim i As Long

'set the destination column
destColumn = InputBox("Enter the name of the destination column :" & Chr(10) & "Eg: AC", "COLUMN NAME")


' Set your source and destination sheets
Set sourceSheet = ThisWorkbook.Sheets("testdata")
Set destinationSheet = ThisWorkbook.Sheets("test")

' Initialize the destination row
destRow = 2

' Loop through each column you want to copy
For col = 1 To 4 ' Adjust the range (1 To 4) to the columns you want to copy
' Find the last row in the current column
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, col).End(xlUp).Row

' Copy each cell from the current column to the destination column
For i = 2 To lastRow
destinationSheet.Cells(destRow, destColumn).Value = sourceSheet.Cells(i, col).Value
destRow = destRow + 1
Next i

Next col

MsgBox "Columns copied successfully!"
End Sub