Copy table data sequentially with VBA

Question

Good morning!

I really need help. I’ve been doing an indicator for meeting minutes. Throughout these meetings the worker writes the minutes in the inclusive excel table problems or improvement opportunities that are talked about throughout the meeting.

These problems or opportunities for improvement should be written in separate columns so that each one initiates an action plan.

On a sheet called "Action Plans" I made a table and I want the problems to appear in order. For example :

='Indicator of Minutes'! O4 ='Minutes Indicator'! P4 ='Minutes Indicator'! Q4 ='Minutes Indicator'! O5 ='Minutes Indicator'! P5 ='Minutes Indicator'! Q5 ='Minutes Indicator'! O6 ='Minutes Indicator'! P6 ='Minutes Indicator'! Q6

And so on and so forth. If this can be done automatically and updated every time a new minutes is written, it is a good advance (I filter to avoid showing the zeroes). However, if by chance it is possible to write only the problems without appearing the empty houses was even better!

Thank you very much if anyone can help me! Ana Ferreira.

Answer 1

All right?

I don’t know what the entire structure of your spreadsheet is, so I focused on the problem you pointed out, namely consolidating information distributed across multiple columns in a single column in the next tab.

The logic of the code below is to find the last populated column in the "Minutes Indicator" tab and, for each filled column, the cells with value other than "empty" are copied and pasted in order in the "D" column of the "Actions Plan" tab".

And that down to the last row filled out of each column of the tab "Minutes Indicator".

I tried to replicate the spreadsheet structure you showed in the question to make it easy for you and put this code on a button.

Follows the code:

Private Sub btOrganiza_Click()

Dim W       As Worksheet
Dim WPlano  As Worksheet
Dim Ln      As Integer
Dim Col     As Integer
Dim UltCol  As Range
Dim UltCel  As Range

Application.ScreenUpdating = False

'Atribui as abas da planilha às variáveis
Set W = Sheets("Indicador de Atas")
Set WPlano = Sheets("Plano de Ações")

'Limpa a coluna D da planilha Plano de Ações
WPlano.Select
WPlano.Range("D4:D1048576").ClearContents

'Encontra a última coluna existente na planilha Indicador de Atas
W.Select
Set UltCol = W.Range("XFD3").End(xlToLeft)

'Seleciona o primeiro intervalo em que estão os comentários
Ln = 4
Col = 15
W.Range(W.Cells(Ln, Col), W.Cells(Ln, Col)).Select

'Realiza a repetição até a última coluna preenchida
Do While Col <= UltCol.Column

    'Encontra a última linha preenchida na coluna atual
    Set UltCel = W.Range(Cells(1048576, Col), Cells(1048576, Col)).End(xlUp)
    
    Do While Ln <= UltCel.Row
        
        If W.Range(W.Cells(Ln, Col), W.Cells(Ln, Col)) <> "" Then
            
            W.Select
            W.Range(W.Cells(Ln, Col), W.Cells(Ln, Col)).Select
            Selection.Copy
            WPlano.Select
            WPlano.Range("D1048576").Select
            Selection.End(xlUp).Select
            ActiveCell.Offset(1, 0).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
        
        End If
    
        Ln = Ln + 1
    
    Loop

    
    Col = Col + 1

Loop

Application.ScreenUpdating = True

'Esvazia as variáveis da memória
Set W = Nothing
Set WPlano = Nothing
Set UltCol = Nothing
Set UltCel = Nothing
Ln = 0
Col = 0

MsgBox "Pronto", vbOKOnly, "Status"

End Sub

Any point, let me know.