sexta-feira, 29 de maio de 2015

Macro em VBA que formata uma planilha (copiando os valores de uma para outra)

Attribute VB_Name = "Módulo_formata"
Sub formata()
'Formata a pasta "txt"
Sheets("txt").Select
Range("b10000").Select
Selection.End(xlUp).Select 'Seleciona limite útil da pasta
Dim break
break = ActiveCell.Row

Range("b2").Select
Do While ActiveCell.Row < break 'Altera as células vazias para "Nome"
    If Left(ActiveCell.Value, 3) = "Sal" Or Left(ActiveCell.Value, 4) = " Sal" Or Left(ActiveCell.Value, 5) = "  Sal" Then
    ActiveCell.Offset(-1, 0).Value = "Nome"
    ActiveCell.Offset(1, 0).Select
    Else
    ActiveCell.Offset(1, 0).Select
    End If
Loop

Range("b1").Select
Do While ActiveCell.Row < break + 1 'coloca nome em todas as linhas na coluna A"
    If ActiveCell.Value = "Nome" Then
    Dim var1
    var1 = ActiveCell.Offset(0, 2).Value
    End If
   
    ActiveCell.Offset(0, -1).Value = var1
    ActiveCell.Offset(1, 0).Select
   
Loop
   
'Alimenta a pasta "base"
Sheets("base").Select
Range("B10000").Select
Selection.End(xlUp).Select 'Seleciona limite útil da pasta
ActiveCell.Offset(1, 0).Select
Sheets("txt").Select
Range("A1").Select
Do While ActiveCell.Row < break + 1
    If ActiveCell.Offset(0, 1).Value = "Nome" Then
        ActiveCell.Copy
        Sheets("base").Select
        ActiveSheet.Paste
        Sheets("txt").Select
        Dim var2
        var2 = ActiveCell.Offset(1, 3).Value
        Sheets("base").Select
        ActiveCell.Offset(0, 1).Value = var2
        Sheets("txt").Select
        Dim var3
        var3 = ActiveCell.Offset(1, 4).Value
        Sheets("base").Select
        ActiveCell.Offset(0, 3).Value = var3
        ActiveCell.Offset(0, 8).Value = "SALÁRIO NORMAL"
        ActiveCell.Offset(1, 0).Select
        ActiveSheet.Paste
        Sheets("txt").Select
        var2 = ActiveCell.Offset(1, 5).Value
        Sheets("base").Select
        ActiveCell.Offset(0, 1).Value = var2
        Sheets("txt").Select
        var3 = ActiveCell.Offset(1, 6).Value
        ActiveCell.Offset(1, 0).Select
        Sheets("base").Select
        ActiveCell.Offset(0, 3).Value = var3
        ActiveCell.Offset(0, 8).Value = "INSS"
        ActiveCell.Offset(1, 0).Select
    Else
        Sheets("txt").Select
        ActiveCell.Copy
        Sheets("base").Select
        ActiveSheet.Paste
        ActiveCell.Offset(0, 1).Value = 0
        Sheets("txt").Select
        Dim var4
        var4 = ActiveCell.Offset(0, 2).Value
        Sheets("base").Select
        ActiveCell.Offset(0, 3).Value = var4
        Sheets("txt").Select
        Dim var5
        var5 = ActiveCell.Offset(0, 1).Value
        ActiveCell.Offset(1, 0).Select
        Sheets("base").Select
        ActiveCell.Offset(0, 8).Value = var5
        ActiveCell.Offset(1, 0).Select
        Sheets("txt").Select
       
    End If
       
     
Loop


'procedimento deletar linhas sem valores

Sheets("base").Select
Range("e10000").Select
Selection.End(xlUp).Select 'Seleciona limite útil da pasta

ActiveCell.Offset(1, 0).Value = "limite"

Range("E2").Select

Do While ActiveCell.Value <> "limite"
   
    If ActiveCell.Value = "0" Or ActiveCell.Value = "" Or ActiveCell.Value = "-" Then
    Selection.EntireRow.Delete
   
    Else
   
    ActiveCell.Offset(1, 0).Select
   
    End If

Loop

ActiveCell.ClearContents

End Sub

Nenhum comentário:

Postar um comentário