Copy non-blank rows in a range in a loop

Question

My table is like that;

A header	Another header
First	row
Second	row


First	row
Second	row

[Here, The blank rows have "".]

I want have a table like this (Values);

A header	Another header
First	row
Second	row
First	row
Second	row

I wrote code to copy and paste as value to new cells.

Dim i As Long
Dim Rng As Range
'for the first table
ActiveSheet.Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ThisWorkbook.Sheets("Sheet1").Range("S3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Set Rng = ActiveSheet.Range("S3")
'Remove "" values that comes from formula

For i = 1 To 600
    If Rng.Cells(i, 1) = "" Then
       Rng.Cells(i, 1).ClearContents
    End If
Next i
'For the second formula
ActiveSheet.Range("A18").Select
Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ThisWorkbook.Sheets("Sheet1").Range("S3").Select
    ThisWorkbook.Sheets("Sheet1").Range("S3").End(xlDown).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Set Rng = ActiveSheet.Range("S3")

    For i = 1 To 600
        If Rng.Cells(i, 1) = "" Then
           Rng.Cells(i, 1).ClearContents
        End If
    Next i
'It continues till 39 table....

I have to paste the code for each data group. I have a very long table so I want make it in a loop.

You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). • It is unclear what your code should do. Can you post a screenshot of the data and a description of what *exactly* your goal is? — Pᴇʜ, Mar 26 '21 at 14:38
If you just want to convert the whole sheet into values try this: `ThisWorkbook.Sheets("SheetNameChangeThis").UsedRange.Value = ThisWorkbook.Sheets("SheetNameChangeThis").UsedRange.Value` this will turn the whole sheet into values. — Damian, Mar 26 '21 at 15:57
Actually my code is working with no problem but I cant figure out how to put in a loop — eren deliaslan, Mar 26 '21 at 18:06

score 0 · Accepted Answer · answered Mar 28 '21 at 20:06

I figure out by myself I dont know if it is a common problem that loop multiple tables to copy and paste while clearing " " cells, but here is my code maybe someone will need it in the future;

Sub test()
Dim j As Long

Dim i As Long
Dim Rng As Range
Set Rng = ActiveSheet.Range("S3")


    ActiveSheet.Cells(3, 1).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ThisWorkbook.Sheets("test").Range("S3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    

    For i = 1 To 600
      If Rng.Cells(i, 1) = "" Then
         Rng.Cells(i, 1).ClearContents
      End If
    Next i

For j = 0 To 525 Step 15

    ActiveSheet.Cells(18 + j, 1).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    ThisWorkbook.Sheets("test").Range("S3").Select
    ThisWorkbook.Sheets("test").Range("S3").End(xlDown).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Set Rng = ActiveSheet.Range("S3")

    For i = 1 To 600
        If Rng.Cells(i, 1) = "" Then
           Rng.Cells(i, 1).ClearContents
        End If
    Next i
Next j


End Sub

Copy non-blank rows in a range in a loop

1 Answers1