VBA Shifts multiple data cells down and inserts rows below

[jhonatan321]

Good morning team, I have a code in vba that shifts the lines from column 8 to the line below it is working perfectly but I have lines that have 10 cells with values and others that only have 1 I made a code too long pulling 50 cells and putting them below and my problem is that a lot of blank cells are coming, I would like to bring only cells with values, I will share the code I am using, the idea is to shift all cells with values in the specified range without bringing blank cells, the code below will shift the cell in column 8 and 9. below column 7Bom dia time, tenho um codigo em vba que desloca as linhas apartir da coluna 8 para linha abaixo esta funcionando perfeitamente porem tenho linhas que tem 10 celulas com valores e outras que só tem 1 eu fiz um codigo extenso demais puxando 50 celulas e colocando abaixo e meu problema é que esta vindo muita celula em branco gostaria de trazer apenas celulas com valores, vou compartilhar o codigo que estou usando, a ideia é deslocar todas as celulas com valores no intervalo especificado sem trazer celulas em branco, o codigo abaixo vai deslocar a celula na coluna 8 e 9. abaixo da coluna 7



Sub organizar_colunas_em_linhas()


'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

Pasta1
	A	B	C	D	E	F	G	H	I	J
1	teste 1	teste 2	teste 3	teste 4	teste 5	teste 6	teste 7	teste 8	teste 9	teste 10
2	aa 1	aa 2	aa 3	aa 4	aa 5	aa 6	aa 7	aa 8	aa 9	aa 10
data