有10列，13行数据，按列合并到新建工作表中，空值不添加

Sub 多列合并到同一列()
Dim k As Integer
Dim ws As Worksheet
On Error Resume Next '如遇错误继续运行
Application.ScreenUpdating = False '关闭屏幕刷新
Application.DisplayAlerts = False '禁用警告提示
Worksheets("汇总").Delete '删除原汇总表
Set ws = Worksheets.Add(before:=Sheets(1)) '新建工作表
ws.Name = "汇总" '新建工作表命名为汇总
k = 1
For j = 1 To 11  '列号
For i = 1 To 13  '行号

If Sheets("Sheet1").Cells(i, j).Value <> "" Then '判断不为空值时合并,如不需要判断去掉这句
ws.Cells(k, 1) = Sheets("Sheet1").Cells(i, j)  '放到新建工作表中
k = k + 1
End If '判断不为空值时合并,如不需要判断去掉这句
Next i, j
Application.DisplayAlerts = True '恢复警告提示
Application.ScreenUpdating = True '开启屏幕刷新
MsgBox "列合并完毕"
End Sub