Hello,
VBA below pulls text from multiple worksheets and places in one cell in master worksheet. However I need to ignore the blank returns as they are creating lots of whitespace in the 'Survey Results' worksheet.
Can anyone help with this?
Thanks, Pitmo
VBA below pulls text from multiple worksheets and places in one cell in master worksheet. However I need to ignore the blank returns as they are creating lots of whitespace in the 'Survey Results' worksheet.
Can anyone help with this?
Code:
Sub TextMerge()Dim x1 As Long
Dim x2 As Long
Dim s As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
s = 0
For Each ws In ActiveWorkbook.Sheets
s = s + 1
If ws.Name = "Start" Then x1 = s + 1
If ws.Name = "End" Then x2 = s - 1
Next
For i = x1 To x2
Sheets("Survey Results").Cells(5, 5).Value = Sheets("Survey Results").Cells(5, 5).Value & vbCrLf & Sheets(i).Cells(4, 5).Value
Next
Sheets("Survey Results").Cells(5, 5).Value = WorksheetFunction.Replace(Sheets("Survey Results").Cells(5, 5).Value, 1, 1, "")
For i = x1 To x2
Sheets("Survey Results").Cells(6, 5).Value = Sheets("Survey Results").Cells(6, 5).Value & vbCrLf & Sheets(i).Cells(5, 5).Value
Next
Sheets("Survey Results").Cells(6, 5).Value = WorksheetFunction.Replace(Sheets("Survey Results").Cells(6, 5).Value, 1, 1, "")
For i = x1 To x2
Sheets("Survey Results").Cells(7, 5).Value = Sheets("Survey Results").Cells(7, 5).Value & vbCrLf & Sheets(i).Cells(6, 5).Value
Next
Sheets("Survey Results").Cells(7, 5).Value = WorksheetFunction.Replace(Sheets("Survey Results").Cells(7, 5).Value, 1, 1, "")
For i = x1 To x2
Sheets("Survey Results").Cells(8, 5).Value = Sheets("Survey Results").Cells(8, 5).Value & vbCrLf & Sheets(i).Cells(7, 5).Value
Next
Sheets("Survey Results").Cells(8, 5).Value = WorksheetFunction.Replace(Sheets("Survey Results").Cells(8, 5).Value, 1, 1, "")
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Thanks, Pitmo