excel - How to loop to copy data following blank cells in a column and paste it to last empty column?

Question

I need to copy a block of data in column A (which are in between blank spaces) and paste it to last empty column. Example: I have data in range A1:A18 and a blank cell, and again data in A20:A37 and 2 blank cells & and again data in A40:A57 & so on. I need to copy those data and paste in Column B, C, D....

The pattern of blank spaces is not uniform.

Screenshot of Excel File

I did some research on the internet and created a code to paste manually selected data in column A to the last empty column. But the list is too long and I want to automate the process.

I tried this code to find blank spaces and copy data. It finds the last blank row and copies all data, popping up an error.

Sub Pasting_Data_to_last_column()
Dim xWs As Worksheet
Dim rng As Range
Dim lastCol As Long

Sheets("Input").Activate
Application.ScreenUpdating = False

'finds the number of the last column
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

Range("A1", Cells(Rows.Count, 1).End(xlUp)).Copy

'paste the copied value to last empty column
Cells(1, lastCol + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub

I believe this problem can be solved with a loop but I don't have any idea about that as I am new to VBA.

标签： excelvba

Answer 1

Try this, which uses SpecialCells to extract blocks of cells (or Areas). It assumes the cells do not contain formulae so if this is not the case, will need changing.

Sub x()

Dim r As Long

For r = 2 To Columns(1).SpecialCells(xlCellTypeConstants).Areas.Count
    Columns(1).SpecialCells(xlCellTypeConstants).Areas(r).Copy
    Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Next r

End Sub