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

Question

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

Navigation

#1 by (0 votes)

0

Good evening people, I created a folder with macro where I have two spreadsheets, Query and games. In the games spreadsheet I put game names and their respective values in real, already in the query I created a list to do the autocomplete with combo box using procv.

So what am I trying to do, get the value of a cell that gets its value from the combo box and copies it to another cell that while doing this, cell selection goes down, to as soon as I select another game, it will again copy the value from that cell to the new one.

I already managed to get the value and throw it in the other cell, but I do not know how to make the selection go to the cell below, I already researched and tried to use the Application.SendKeys "{ENTER}" but it did not work, I I thought about using For each and I managed to make the line jump, but after that I could not find 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

if foreach vba excel-vba

asked by anonymous 08.08.2018 / 22:54

1 answer

Image upload with problem in nodejs Perform tests based on component lifecycle

score 0 · Answer 1

SendKeys

The Application.SendKeys "{ENTER}" method will only hit the Enter key when called. So if your cursor was in VBA code. It will give New Line command in VBE.

Code Problems

Statement

The statement is incorrect this way:

Dim limite, celula As Range

Where limite is declared only as Variant and celula as Range . The correct would be:

Dim limite As Range, celula As Range

(Strange syntax that occurs in VBA)

For Each

For Each is written in code, but is not used at any time.

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

So you're not using the loop. Just trying to write individual cell values in the same place.

Solution

Last Cell

I think I misunderstood the question, what you want is to enter 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 lines in E

For multiple values in column E

For Each

A solution with a loop in each cell, the way you are trying to do 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