VBA SELECT THE FIRST CELLS THAT CONTAIN TEXT AND SHIFT THE VALUE BELOW IN THE RANGE

[jhonatan321]

Can anyone help me with this code that I have problems doing for the last 2 days. What I need to do is find the last column in that particular row starting from column H onwards, if there is any text that shifts down the row in column G and repeat the action; when it finds the text in a cell it will then insert a row below it and cut and paste the text on the row below in column G. This continues until all cells from H onwards contain no text and proceeds to the next Row, repeating an action above.

my code does this but it got long and heavy because I had to create several ifs specifying which columns need to be shifted, because I have rows with more and others with less filled cells




in this example below, follow the reference: my column starts at H and the text of the cells onwards shift to column G blank cells will not be necessary to shift down.

Sub organizar_colunas_em_linhas()

' ESSE CODIGO IRA COLOCAR VARIAS COLUNAS NA MESMA LINHA
'Declarations
Dim wsData As Worksheet

Dim rngCopy As Range
Dim rngCopy1 As Range
Dim i As Long 'Loop variable
Dim j As Long 'Loop variable

Dim lngFirstDataRow As Long
Dim lngLastDataRow As Long

Dim boolDataFound As Boolean 'True or false value

'Initialization
Set wsData = ActiveSheet
lngFirstDataRow = 2 'Replace with your own value - row where the data starts
lngLastDataRow = 10760 'Replace with your own value - row where the data ends

'Loop from the bottom to top. Why? Because when we insert
'rows, it will shift stuff down.
For i = lngLastDataRow To lngFirstDataRow Step -1

'Check columns u - t for data
boolDataFound = False
For j = 1 To 1 'AL is the 38th column, AP the 42nd
'If it's not blank...
If Not wsData.Cells(i, j).Text = "" Then

'...then there is data. Change the boolean to TRUE and exit the for loop
boolDataFound = True
Exit For
End If
Next j

' I,X qual celula em qual coluna esta trazendo para baixo o dado
'If we found data there

If boolDataFound Then

'Insert a new row below the current row
wsData.Rows(i + 1).Insert Shift:=xlShiftDown

'Copy the data
Set rngCopy = wsData.Range(wsData.Cells(i, 9), wsData.Cells(i, 9))
rngCopy.Copy

'Copy that data into cells A-F
wsData.Cells(i + 1, 7).PasteSpecial xlPasteAll ' ordem inicial

End If
'''
'If we found data there
If boolDataFound Then

'Insert a new row below the current row
wsData.Rows(i + 1).Insert Shift:=xlShiftDown
'Copy the data
Set rngCopy = wsData.Range(wsData.Cells(i, 8), wsData.Cells(i, 8))
rngCopy.Copy

'Copy that data into cells A-F
wsData.Cells(i + 1, 7).PasteSpecial xlPasteAll ' ordem inicial

End If
'''
Next i

'Remove the copy mode
Application.CutCopyMode = False






End Sub