Вырезать и вставлять блоки данных под первым блоком, используя VBA

Question

Я пытался найти / найти код VBA, который копирует блоки данных под моим первым блоком.Каждый блок состоит из 19 столбцов, за которыми следует пробел.Количество строк в блоке может варьироваться.

Смотрите мой скриншот ниже:

Поэтому я хотел бы, чтобы все мои данные были непрерывнымив первых столбцах A:S.Любая помощь очень ценится.

Я нашел следующий код в сети, но он вставляет только все в первый столбец

Sub Column()

Dim iLastcol As Long
Dim iLastRow As Long
Dim jLastrow As Long
Dim ColNdx As Long
Dim ws As Worksheet
Dim myRng As Range
Dim ExcludeBlanks As Boolean
Dim mycell As Range

ExcludeBlanks = (MsgBox("Exclude Blanks", vbYesNo) = vbYes)
Set ws = ActiveSheet
iLastcol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
On Error Resume Next

Application.DisplayAlerts = False
Worksheets("Alldata").Delete
Application.DisplayAlerts = True

Sheets.Add.Name = "Alldata"

For ColNdx = 1 To iLastcol

iLastRow = ws.Cells(ws.Rows.Count, ColNdx).End(xlUp).Row

Set myRng = ws.Range(ws.Cells(1, ColNdx), _
                   ws.Cells(iLastRow, ColNdx))

If ExcludeBlanks Then
  For Each mycell In myRng
     If mycell.Value <> "" Then
        jLastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
                   .End(xlUp).Row
        mycell.Copy
        Sheets("Alldata").Cells(jLastrow + 1, 1) _
           .PasteSpecial xlPasteValues
      End If
    Next mycell
      Else
       myRng.Copy
          jLastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
            .End(xlUp).Row
      mycell.Copy
      Sheets("Alldata").Cells(jLastrow + 1, 1) _
     .PasteSpecial xlPasteValues
    End If
   Next

   Sheets("Alldata").Rows("1:1").EntireRow.Delete

   ws.Activate
 End Sub

Answer 1

Базовый подход:

Sub Tester()

    Dim c As Range, addr

    Set c = ActiveSheet.Range("T1")

    Do
        Set c = c.End(xlToRight)
        If c.Column = Columns.Count Then Exit Do
        addr = c.Address 'strire the address since Cut will move c
        c.CurrentRegion.Cut c.Parent.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        Set c = ActiveSheet.Range(addr) '<< reset c
    Loop


 End Sub

Answer 2

Это немного более просто, чем @ TimWilliams

With ThisWorkbook.Sheets("Alldata")

Dim lRow As Long, lCol As Long, cpyrng As Range

lCol = Cells(1, Columns.Count).End(xlToLeft).Column

    For i = 21 To lCol Step 20
        If .Cells(1, i).Value <> "" And .Cells(1, i).Offset(, -1).Value = "" Then

            lRow = .Cells(.Rows.Count, 1).End(xlUp).Row

            Set cpyrng = .Cells(1, i).CurrentRegion

            cpyrng.Cut
            Sheets("Sheet2").Cells(lRow, 1).Offset(2).Insert Shift:=xlDown
        End If
    Next i
End With