VBA将数据移动到左边（每行需要移动4列，在需要保留的4列内可能有空白）

我有一个有一组问题的数据集。 但是部分数据已经被复制（4列）。 这些需要根据他们的标题合并成4列（答案1，答案2，答案3，答案4）。

下面是示例图像

我试过这个：

Sub MoveLeft() Dim r As Long, rws As Long Application.ScreenUpdating = False With ActiveSheet.UsedRange rws = .Rows.Count r = 1 On Error Resume Next Do .Rows(r).Resize(8000).SpecialCells(xlBlanks).Delete Shift:=xlToLeft r = r + 8000 Loop While r <= rws On Error GoTo 0 End With Application.ScreenUpdating = True End Sub 

但是它没有保留我需要的空白

Answer 1

你不可能在8000行的组中做到这一点。 每一行都需要单独完成。

 Sub qwerty() Dim r As Long, pos As Long With Worksheets("sheet2") With Intersect(.Range("F:AC"), .UsedRange.Cells) For r = 2 To .Rows.Count .Cells(r, 1).Resize(1, 4).ClearContents pos = .Cells(r, 1).End(xlToRight).Column - .Cells(r, 1).Column If pos <= .Columns.Count Then pos = Application.Floor(pos, 4) + 1 .Cells(r, 1).Resize(1, 4) = .Cells(r, pos).Resize(1, 4).Value2 End If Next r End With End With End Sub