Células de preenchimento, nova entrada sempre no topo com número seqüencial adicionado a ele

0

Sou bastante novo no VBA no Excel, mas preciso dele para um pequeno projeto em que estou trabalhando e posso usar sua ajuda.

O que eu preciso fazer é preencher uma lista em uma folha separada ("máquinas") em uma pasta de trabalho de outra planilha ("NewMachine") na qual insiro informações, essas informações inseridas na planilha "NewMachine" são limpas. pronto para outra entrada.

Gostaria que as novas entradas entrassem no topo da lista e tivessem 2 números sequenciais adicionados a essa linha, correspondentes à nova entrada.

Essencialmente

Coluna A Coluna B Coluna C

... ... ...

2 2 Informação

1 1 Informação

Este é o código que eu tenho até agora:

Sub capturedata()

Dim wks As Worksheet
Dim lastrow As Long

Set wks = Sheets("Machines")

lastrow = wks.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row


wks.Cells(lastrow + 1, 3).Value = Cells(6, 2).Value
wks.Cells(lastrow + 1, 4).Value = Cells(7, 2).Value
wks.Cells(lastrow + 1, 5).Value = Cells(8, 2).Value
wks.Cells(lastrow + 1, 6).Value = Cells(9, 2).Value
wks.Cells(lastrow + 1, 7).Value = Cells(10, 2).Value
wks.Cells(lastrow + 1, 8).Value = Cells(11, 2).Value
wks.Cells(lastrow + 1, 9).Value = Cells(12, 2).Value
wks.Cells(lastrow + 1, 10).Value = Cells(13, 2).Value
wks.Cells(lastrow + 1, 11).Value = Cells(14, 2).Value


Range("B6:B14").ClearContents

End Sub

Isso permite que eu insira as informações para preencher a lista de cima para baixo, mas não muito mais.

    
por aschark 19.01.2017 / 10:01

1 resposta

0

new entries come in at the top of the list

Insira uma nova linha acima da segunda linha em vez de procurar lastrow

Além disso, você pode copiar todo o intervalo uma vez em vez de passar por cada célula.

Sub capturedata()

    Dim wks As Worksheet

    Set wks = Sheets("Machines")

    With wks
        .Rows(2).EntireRow.Insert
        .Range("C2:K2") = Range("B6:B14").Value
    End With

    Range("B6:B14").ClearContents

End Sub
    
por 19.01.2017 / 16:55