VBA Module that stores data from one cell and moves it to another cell and moves to the bottom cell

Question

Good evening guys, I created a folder with macro where I have two spreadsheets, Query and games. In the spreadsheet games I put name of games and their respective values in real, already in the query I created a list to make the autocomplete with combo box using the PROCV.

So what I’m trying to do, get the value of a cell that, gets its value from the combo box and copies it to another cell that by doing this, the selection of the cell goes down, so as soon as I go and select another game, it will re-copy the value of that cell to the new.

I’ve managed to get the value and throw it in the other cell, but I don’t know how to make the selection go to the bottom cell, I’ve already researched and tried to use the Application.Sendkeys "{ENTER}" but it didn’t work, I thought to use For each and managed to jump the line, but after that I couldn’t make a way to get the value again.

Follow the code below.

Sub teste()
Dim exame As String
Dim valor As Double
Dim limite, celula As Range


Set limite = Range("F2:F50")


    For Each celula In limite.Offset(0, 5)

        If Range("E4").Value <> "" Then
            exame = Range("E4").Value
            valor = Range("D5").Value

            Range("F2").Value = exame
            Range("G2").Value = valor

        End If
    Next

End Sub

Answer 1

Sendkeys

The method Application.SendKeys "{ENTER}" will only press the key Enter when it is called. Therefore, if your cursor was in the VBA code. It will give the command of New Line in the VBE.

Problems in the Code

Statement

The statement is incorrect in this way:

Dim limite, celula As Range

In which limite is declared only as Variant and celula as Range. The right thing would be:

Dim limite As Range, celula As Range

(Strange syntax that occurs in VBA)

For Each

For Each is written in the code, but at no time is it used.

For Each celula In limite.Offset(0, 5)
Next celula

Therefore, you are not using the loop. Just trying to write the individual cell values in the same place.

Solution

Last Cell

I think I misunderstood the question, what you want is to insert values below the last filled cell. So the code would be this:

Dim exame As String
Dim valor As Double
Dim UltimaLinhaF As Long
Dim planilha As Worksheet
Set planilha = ThisWorkbook.Worksheets("nome_da_planilha")

With planilha
    UltimaLinhaF = .Cells(.Rows.Count, "F").End(xlUp).Row
      If .Range("E4").Value <> "" Then
        exame = .Range("E4").Value
        valor = .Range("D5").Value

        .Range("F" & UltimaLinhaF + 1).Value = exame
        .Range("G" & UltimaLinhaF + 1).Value = valor

    End If
End With

Solution for multiple E lines

For various values in column E

For Each

A solution with a loop in each cell, the way you’re trying to do it is:

Dim exame As String
Dim valor As Double
Dim limite As Range, celula As Range
Dim UltimaLinhaE As Long, contador As Long
Dim planilha As Worksheet
Set planilha = ThisWorkbook.Worksheets("nome_da_planilha")

With planilha
    UltimaLinhaE = .Cells(.Rows.Count, "E").End(xlUp).Row

    Set limite = .Range("E2:E" & UltimaLinhaE)
    contador = 2 'Inicia na linha 2
    For Each celula In limite
        If celula.Value <> "" Then
            exame = celula.Value             'Valor na Coluna E
            valor = celula.Offset(, -1).Value 'Valor na Coluna D

            'Escrever os respectivos valores em F e G
            .Cells(contador, "F") = exame          'Escreve em F
            .Cells(contador, "G") = valor          'Escreve em G
            contador = contador + 1
        End If
    Next celula
End With

Autofilter

Dim limite As Range
Dim UltimaLinhaE As Long
Dim planilha As Worksheet
Set planilha = ThisWorkbook.Worksheets("nome_da_planilha")

With planilha
    If .FilterMode Then .ShowAllData
    UltimaLinhaE = .Cells(.Rows.Count, "E").End(xlUp).Row

    Set limite = .Range("E2:E" & UltimaLinhaE)
    limite.AutoFilter field:=1, Criteria1:="<>"

    .Range("E1:E" & UltimaLinhaE).SpecialCells(xlCellTypeVisible).Copy .Range("F2")
    .Range("D1:D" & UltimaLinhaE).SpecialCells(xlCellTypeVisible).Copy .Range("G2")
    If .FilterMode Then .ShowAllData
End With