Macro para inserir linha sob condição.

[Cleiton Dias]

Olá,

Estou querendo montar uma macro para adicionar uma linha em uma tabela.

Algo +/- assim:

Tipo............|Descrição.......|Valor

Despesa.......Agua...............xxxx

Despesa.......Luz..................xxxx

Despesa.......Telefone..........xxxx

Receita.........Pag. Caixa.......xxxx

Receita.........Depósitos.........xxxx

Receita.........Acordos...........xxxx

Imobilizado...Veículos...........xxxx

Imobilizado...Móveis.............xxxx

O que eu queria era colocar um botão, com a macro. A macro procuraria na coluna A pelo valor "Despesa", e adicionaria uma linha logo a baixo do ultimo valor "Despesa", sempre que ativada.

Alguém poderia me dar uma ajuda neste projeto?

Grato

[zinhovba]

Boa tarde!!!

Creio que fazendo uma adaptação esse código lhe será últil.

Option Explicit

Sub exa()

Dim REX As Object '<-- RegExp

Dim lLRow As Long

Dim i As Long

'// Set a reference to Regular Expressions and a simple pattern simply requiring it //

'// to find the word with word boundaries leading/following. If you find you need //

'// to include stuff like "totals", "totalling", etc - the pattern would need changed//

Set REX = CreateObject("VBScript.RegExp")

With REX

.Pattern = "\btotal\b"

.Global = False

.IgnoreCase = True

End With

With Sheet1 '<-- codename or sheet/tab name -->ThisWorkbook.Worksheets ("Sheet1")

lLRow = .Cells(.Rows.Count, 1).End(xlUp).Row

For i = lLRow To 1 Step -1

If REX.Test(.Cells(i, 1).Value) Then

.Cells(i, 1).Characters(Start:=REX.Execute(.Cells(i, 1).Value)(0).FirstIndex + 1, _

Length:=5) _

.Font.FontStyle = "Bold"

.Rows(i + 1).Insert Shift:=xlDown

End If

Next

End With

End Sub

Att..

[Cleiton Dias]

Cara... não entendi nada! rsrsrs!!

Eu to começando a mexer com macro agora.

Até agora, o que eu consegui foi isso:

Sub Adicionar()

Dim i As Range

For Each i In Range("A8:A100")

If i.Value = "DESPESA" Then

i.Select

Selection.End(xlDown).Select

End If

Next i

End Sub

Nesse caso, ele encontra o valor "Despesa" na coluna, mas depois do comando Selection.End(xlDown).Select, ele seleciona o ultimo valor da coluna.

Eu gostaria que ele selecionasse o ultimo valor "Despesa" para que, depois, adicionasse uma linha.

[JoséA]

Penso que esse tópico poderá lhe ajudar. :blink:

http://www.babooforum.com.br/forum/index.p...vb/page__st__20

[Cleiton Dias]

Penso que esse tópico poderá lhe ajudar. :blink:

http://www.babooforum.com.br/forum/index.p...vb/page__st__20

Olá José!

Obrigado pela resposta!

Acho que é exatamente isso que eu procuro, no entanto eu não estou conseguindo aplicar isso a minha macro.

O problema é q eu não quero encontrar a ultima célula preenchida, e sim a ultima célula com o valor "Despesa", isso que eu não estou conseguindo fazer.

[Cleiton Dias]

Bom, até agora eu consegui isso:

Sub AdicionarD()

Dim i As Range

For Each i In Range("A8:A100")

If i.Value = "DESPESA" Then

i.Select

Selection.End(xlDown).Select

ActiveCell.Offset(-1, 0).Select

Selection.EntireRow.Insert

End If

Next i

End Sub

O problema é q a Macro não para de adicionar linhas! rsrsrs!!

Editado Setembro 3, 2011 por Cleiton Dias

[Cleiton Dias]

Bom, pesquisando na internet achei a Macro que queria. Segue:

Sub InsereLinha()

Dim i As Long

For i = 50007 To 1 Step -1

If Cells(i, "A") = "DESPESA" Then

Cells(i, "A").EntireRow.Insert

Exit Sub

End If

Next i

End Sub

O único detalhe, é q a formula insere a linha abaixo do penúltimo resultado e não do último, mas para mim já tá ótimo!

Valeu galera!!

[Ari Alves]

Bom, acho que é isso que tas querendo.

Sub Inserir_linha()
'
' Inserir_linha Macro
'

'
    Rows("5:7").Select
    Selection.EntireRow.Hidden = False
    Rows("6:6").Select
    Selection.Copy
    Rows("7:7").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    Range("A1").Select
    Selection.Copy
    Range("A7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A7:A24").Select
    ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Add Key:=Range("A7"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Plan1").Sort
        .SetRange Range("A7:B9")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("6:6").Select
    Selection.EntireRow.Hidden = True
    Range("B7").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    Selection.End(xlToLeft).Select
End Sub