Sub ConcatenateText()
Dim lastRow As Long
Dim lastCol As Long
Dim tempLastRow As Long
Dim i As Long 'Increment Rows
Dim p As Long 'Increment Columns
Dim conValue As String
Dim conSheet As String 'Concatenate Sheet Name
Dim destSheet As String 'Destination Sheet Name
destSheet = "Sheet1"
conSheet = "surveyText"
lastRow = Sheets(conSheet).Range("A" & Rows.Count).End(xlUp).Row
lastCol = Sheets(conSheet).Range(Columns.Count & ":1").End(xlToRight).Column
For i = 2 To lastRow
For p = 2 To lastCol Step 2
conValue = conValue & " | " & Sheets(conSheet).Cells(i, p).Value
Next
tempLastRow = Sheets(destSheet).Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets(destSheet).Cells(tempLastRow, 1).Value = Right(conValue, Len(conValue) - 3)
conValue = ""
Next i
MsgBox "Done!"
End Sub
sampleText-concatenate.xls
Sub append_text()
Dim txt As String
For i = 2 To Cells(1, 65536).End(xlUp).Row
For j = 2 To Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column Step 2
txt = txt & Cells(i, j).Value & "|"
Next
Sheet1.Range("A" & i).Value = txt
Next
End Sub
Sub append_text()
Dim txt As String
For i = 2 To Cells(1, 65536).End(xlUp).Row
For j = 2 To Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column Step 2
txt = txt & Cells(i, j).Value & "|"
Next
Sheet1.Range("A" & i).Value = txt
txt = ""
Next
End Sub
Sub ConcatenateText()
Dim lastRow As Long
Dim lastCol As Long
Dim tempLastRow As Long
Dim tempLastCol As Long
Dim i As Long 'Increment Rows
Dim p As Long 'Increment Columns
Dim conValue As String
Dim conSheet As String 'Concatenate Sheet Name
Dim destSheet As String 'Destination Sheet Name
destSheet = "Sheet1"
conSheet = "surveyText"
lastRow = Sheets(conSheet).Range("A" & Rows.Count).End(xlUp).Row
lastCol = Sheets(conSheet).Range(Columns.Count & ":1").End(xlToRight).Column
tempLastCol = Sheets(destSheet).Range(Columns.Count & ":1").End(xlToRight).Column + 1
For i = 2 To lastRow
For p = 2 To lastCol Step 2
conValue = conValue & " | " & Sheets(conSheet).Cells(i, p).Value
Next
tempLastRow = Sheets(destSheet).Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets(destSheet).Cells(tempLastRow, tempLastCol).Value = Right(conValue, Len(conValue) - 3)
conValue = ""
Next i
MsgBox "Done!"
End Sub
If you are experiencing a similar issue, please ask a related question
Join the community of 500,000 technology professionals and ask your questions.