Hi!
need VBA code for table that move data cells from starting of the table and blanks cells after data cells.
Have Like this,
there are many tables like this below these tables,
Tables have format like Column B to F, H, K & L Manually input and Column G & I have formula. Talbe have no header row (means hided) and have total row.
So need to do that if first row of Column B of the table have data then check next row of Column B; and if cell of Column B found empty then copy data from next non-empty cell of columns B to F, H, K & L and paste here and then delete from copied cells. loop through all rows until last row of the table. and same loop through all tables in activesheet.
Please note that don't want to delete any row of cell, just move it.
Want result like this
for the same have write and tried below code, but it is not giving end result as want. It is working in 1st two row properly and then copying value from up side instead to find down side. and all data rows pasting at end of the table.
this code result:
Thank You.
need VBA code for table that move data cells from starting of the table and blanks cells after data cells.
Have Like this,
there are many tables like this below these tables,
Tables have format like Column B to F, H, K & L Manually input and Column G & I have formula. Talbe have no header row (means hided) and have total row.
So need to do that if first row of Column B of the table have data then check next row of Column B; and if cell of Column B found empty then copy data from next non-empty cell of columns B to F, H, K & L and paste here and then delete from copied cells. loop through all rows until last row of the table. and same loop through all tables in activesheet.
Please note that don't want to delete any row of cell, just move it.
Want result like this
for the same have write and tried below code, but it is not giving end result as want. It is working in 1st two row properly and then copying value from up side instead to find down side. and all data rows pasting at end of the table.
Code:
Option Explicit
Sub CopyDataToBlanks()
Dim tbl As ListObject
Dim rng As Range
Dim i As Long
For Each tbl In ActiveSheet.ListObjects
Set rng = tbl.Range
For i = 1 To rng.Rows.Count - 1
If rng.Cells(i, 1) = "" Then
rng.Cells(1, 1).Offset(1, 0).End(xlDown).Copy rng.Cells(i, 1)
rng.Cells(1, 1).Offset(1, 0).End(xlDown).ClearContents
rng.Cells(1, 2).Offset(1, 0).End(xlDown).Copy rng.Cells(i, 2)
rng.Cells(1, 2).Offset(1, 0).End(xlDown).ClearContents
rng.Cells(1, 3).Offset(1, 0).End(xlDown).Copy rng.Cells(i, 3)
rng.Cells(1, 3).Offset(1, 0).End(xlDown).ClearContents
rng.Cells(1, 4).Offset(1, 0).End(xlDown).Copy rng.Cells(i, 4)
rng.Cells(1, 4).Offset(1, 0).End(xlDown).ClearContents
rng.Cells(1, 5).Offset(1, 0).End(xlDown).Copy rng.Cells(i, 5)
rng.Cells(1, 5).Offset(1, 0).End(xlDown).ClearContents
rng.Cells(1, 7).Offset(1, 0).End(xlDown).Copy rng.Cells(i, 7)
rng.Cells(1, 7).Offset(1, 0).End(xlDown).ClearContents
rng.Cells(1, 10).Offset(1, 0).End(xlDown).Copy rng.Cells(i, 10)
rng.Cells(1, 10).Offset(1, 0).End(xlDown).ClearContents
rng.Cells(1, 11).Offset(1, 0).End(xlDown).Copy rng.Cells(i, 11)
rng.Cells(1, 11).Offset(1, 0).End(xlDown).ClearContents
End If
Next i
Next tbl
End Subthis code result:
Thank You.
