CODEWITHSUNDEEP
vbaexcelloopscopy-paste
ShieldData
ShieldData

Reputation: 125

Removing blank cells and structuring data while copying VBA

I am currently working on a project where I need to copy a targeted range in one workbook and paste it into another workbook omitting all the blank cells (which there are a lot of).

So far I have managed to either paste them all in a row next to each other, but I haven't managed to structure it appropriately.

        For Each c In rngSourceRange.SpecialCells(xlCellTypeVisible)
            If Len(c) <> 0 Then
                rngDestination = c.Value
                Set rngDestination = rngDestination.Offset(0, 1)
            End If
        Next c

        Application.CutCopyMode = False

The format should be as such. The first 19 cells should go in a row next to each other and then it should move down a row go back to the first column and list the next 19 entries, and so on until I am all out of cells to copy. Now I have tried to include another for-loop but it produced a very useless result.

        For Each c In rngSourceRange.SpecialCells(xlCellTypeVisible)
            If Len(c) <> 0 Then
            For lcol = 1 To 19
                wkbCrntWorkBook.Sheets("Tabelle1").Cells(lrow, lcol).Value = c.Value
                lrow = lrow + 1
            Next lcol
            End If
        Next c

        Application.CutCopyMode = False

Please help me properly structure this dataset. I can show the rest of my code if that would be of any help.

Upvotes: 2

Views: 55

Answers (1)

A.S.H
A.S.H

Reputation: 29332

In you first code, after this statement:

Set rngDestination = rngDestination.Offset(0, 1)

Try adding the following statement:

 If rngDestination.Column > 19 Then _
   Set rngDestination = rngDestination.EntireRow.Offset(1).Cells(1)

Upvotes: 1

Related Questions