Transpose columns to rows but without blanks

[PIsabel]

Hello.
I have a sheet that concatenates the data entered.
For this I have several columns that concatenate the different options.
Then I have to pass all the columns to a list.
The code I have copies and pastes each set of columns, however the options that are not used create blank lines and this means that I end up not being able to use it the way I want, in addition to being a code that takes a long time to perform the task. .
I need code that copies the data from each set of columns, pastes this data into the "Components" sheet so that the list has no blank lines and orders the data by column A.
I have 30 sets of columns. All column sets have 7 columns and rows range from 3 to 1001.
Someone help me?

Sub componentes_cria()
'copia e cola dados dos compostos para a folha componentes

    Application.ScreenUpdating = False
    Sheets("Componentes").Visible = True
    Sheets("Componentes").Select
    Range("A2:X30000").Select
    Selection.ClearContents
    '
    Application.Goto Reference:="Comp_artigos"
    Selection.Copy
    Sheets("Componentes").Select
    Range("A2").Select
    Application.Run "Personal.xlsb!Colar_especial"
    '
    Sheets("Compostos").Select
    Application.Goto Reference:="comp_fabrico"
    Selection.Copy
    Sheets("Componentes").Select
    Range("A30000").End(xlUp).Offset(1, 0).Select
    Application.Run "Personal.xlsb!Colar_especial"
    '
    Sheets("Compostos").Select
    Application.Goto Reference:="comp_polimento"
    Selection.Copy
    Sheets("Componentes").Select
    Range("A30000").End(xlUp).Offset(1, 0).Select
    Application.Run "Personal.xlsb!Colar_especial"
    '
    Sheets("Compostos").Select
    Application.Goto Reference:="comp_serralheiro"
    Selection.Copy
    Sheets("Componentes").Select
    Range("A30000").End(xlUp).Offset(1, 0).Select
    Application.Run "Personal.xlsb!Colar_especial"
    '
    Sheets("Compostos").Select
    Application.Goto Reference:="comp_vidro"
    Selection.Copy
    Sheets("Componentes").Select
    Range("A30000").End(xlUp).Offset(1, 0).Select
    Application.Run "Personal.xlsb!Colar_especial"
    '
    Sheets("Compostos").Select
    Application.Goto Reference:="comp_estofo"
    Selection.Copy
    Sheets("Componentes").Select
    Range("A30000").End(xlUp).Offset(1, 0).Select
    Application.Run "Personal.xlsb!Colar_especial"

 

[bobaol]

Hi, let me see if i understand your question. for example, let's take columns DO to DU. you're saying copy DO3:DU1001, then paste Transpose into cell A2 of sheet Componentes. But the problem you're having is that it also pastes blanks. and you do not want to paste blanks. is this the problem you're trying to solve? If the problem is trying to get rid of the blanks, you can try this method. 1. copy all of columns DO to DU to a new book, call it "temp". paste to A1. after pasting, your data is now in column A to G. At this point, in column H, add a row index, so that H1 is equal to 1, H2 is equal to 2, H999 is equal to 999. After adding this row index any which way you want, get rid of the empty rows, then sort by column H again at the very end. Sorting by column H will get your data back into its original order, but without the empty rows. now, you can copy A to G and paste transpose without any empty rows. Hope this helps.