-
Posts
6 -
Cadastrado em
-
Última visita
Tipo de conteúdo
Artigos
Selos
Fabricantes
Livros
Cursos
Análises
Fórum
posts postados por Jéssica De Moura Lima
-
-
Boa tarde,
Preciso de uma macro que seja executada automaticamente, de acordo com o valor da célula "D11".
Para tal, fiz o seguinte código (que está funcionando, mas não é executado automaticamente ao alterar a célula):
Sub Exibir_Billing_Atual()
ActiveSheet.Unprotect Password:="12345"
If Range("D11").Value = "Projeto" ThenRange("D17").Value = 0
Range("D17:D18").Select
Selection.EntireRow.Hidden = True
Range("D11").SelectElseIf Range("D11").Value = "Aditivo" Then
Rows("17:18").Select
Selection.EntireRow.Hidden = False
Range("D17").Select
End If
ActiveSheet.Protect Password:="12345"
End SubAlguém poderia me ajudar?
-
Prezados,
Gostaria de copiar dados de colunas específicas (células não vazias) e colar em outra guia. Com este código, apenas os dados da primeira coluna são copiados e colados.
Alguém poderia me ajudar?
Sub Registrar_fixos()
Dim Sht1 As Worksheet
Dim Sht2 As Worksheet
Dim lin As LongSet Sht1 = Sheets("Contratos Fixos")
Set Sht2 = Sheets("Controle de Faturamento")
lin = 14
Application.ScreenUpdating = False'Desbloquear guia e pasta de trabalho
ThisWorkbook.Unprotect ("123")
Sht1.Unprotect ("123")
Sht2.Unprotect ("123")
'Copiar coluna "Nº Pedido"
Sht1.Activate
While Sht1.Cells(lin, 3) <> ""
Sht1.Cells(lin, 3).Copy
'Colar coluna "Nº Pedido"
Sht2.Activate
Sht2.Range("B9").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End IfLoop Until ActiveCell = ""
ActiveCell.PasteSpecial xlPasteValues
lin = lin + 1
Wend
'Copiar coluna "Projeto"
Sht1.Activate
While Sht1.Cells(lin, 4) <> ""
Sht1.Cells(lin, 4).Copy
'Colar coluna "Projeto"
Sht2.Activate
Sht2.Range("C9").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""ActiveCell.PasteSpecial xlPasteValues
lin = lin + 1
Wend
'Copiar coluna "Nº Item"
Sht1.Activate
While Sht1.Cells(lin, 5) <> ""
Sht1.Cells(lin, 5).Copy
'Colar coluna "Nº Item"
Sht2.Activate
Sht2.Range("D9").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""ActiveCell.PasteSpecial xlPasteValues
lin = lin + 1
Wend
'Copiar coluna "Item"
Sht1.Activate
While Sht1.Cells(lin, 6) <> ""
Sht1.Cells(lin, 6).Copy
'Colar coluna "Item"
Sht2.Activate
Sht2.Range("E9").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""ActiveCell.PasteSpecial xlPasteValues
lin = lin + 1
Wend
'Copiar coluna "Cliente Raiz"
Sht1.Activate
While Sht1.Cells(lin, 7) <> ""
Sht1.Cells(lin, 7).Copy
'Colar coluna "Cliente Raiz"
Sht2.Activate
Sht2.Range("F9").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""ActiveCell.PasteSpecial xlPasteValues
lin = lin + 1
Wend
'Copiar coluna "Tipo de Contrato"
Sht1.Activate
While Sht1.Cells(lin, 21) <> ""
Sht1.Cells(lin, 21).Copy
'Colar coluna "Tipo de Contrato"
Sht2.Activate
Sht2.Range("G9").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""ActiveCell.PasteSpecial xlPasteValues
lin = lin + 1
Wend
'Copiar coluna "Valor a Faturar (BRL)"
Sht1.Activate
While Sht1.Cells(lin, 20) <> ""
Sht1.Cells(lin, 20).Copy
'Colar coluna "Valor a Faturar (BRL)"
Sht2.Activate
Sht2.Range("H9").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""ActiveCell.PasteSpecial xlPasteValues
lin = lin + 1
Wend
Application.CutCopyMode = False
Sht1.Activate
'Atualizar status da guia "Contratos Fixos"
Sht1.Range("D9").Value = "p"'Bloquear guia e pasta de trabalho
ThisWorkbook.Protect Password:="123", Structure:=True, Windows:=False
Sht1.Protect Password:="123", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
UserInterfaceOnly:=True, _
AllowFormattingCells:=False, _
AllowFormattingColumns:=False, _
AllowFormattingRows:=True, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=True, _
AllowSorting:=False, _
AllowFiltering:=True, _
AllowUsingPivotTables:=False
Sht2.Protect Password:="123", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
UserInterfaceOnly:=True, _
AllowFormattingCells:=False, _
AllowFormattingColumns:=False, _
AllowFormattingRows:=True, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=True, _
AllowSorting:=False, _
AllowFiltering:=True, _
AllowUsingPivotTables:=False
Application.ScreenUpdating = TrueMsgBox "Faturamento registrado com sucesso!"
End Sub
-
Olá!
Gostaria de importar dados de um arquivo externo, mas o meu código não está funcionando.
Sub Importar()
Dim Abrir As String
Dim Importarwb As Workbook
Dim Importarguia As WorksheetAbrir = Application.GetOpenFilename( _
FileFilter:="Arquivo do Excel (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Escolha o arquivo a ser importado")Set Importarwb = Application.Workbooks.Open( _
Filename:=Abrir, Password:="123")Set Importarguia = Importarwb.Worksheets(1)
Application.ScreenUpdating = False
'Desbloquear guia e pasta de trabalho
ThisWorkbook.Unprotect ("123")
ActiveSheet.Unprotect ("123")'Copiar dados
Importarguia.Copy'Limpar guia "Relatório" e colar dados
Worksheets("Relatório").Visible = TrueWith Worksheets("Relatório")
.Visible = True
.Range(.Cells(1, 1), .Cells(10000, 90)).ClearContents
.Paste
.Visible = False
End With'Fechar arquivo externo
Importarwb.Close'Bloquear guia e pasta de trabalho
ThisWorkbook.Protect Password:="123", Structure:=True, Windows:=FalseSheets("Base de Contratos").Protect Password:="123", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
UserInterfaceOnly:=True, _
AllowFormattingCells:=False, _
AllowFormattingColumns:=False, _
AllowFormattingRows:=True, _AllowInsertingColumns:=False, _
AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=True, _
AllowSorting:=False, _
AllowFiltering:=True, _
AllowUsingPivotTables:=FalseApplication.ScreenUpdating = True
MsgBox "Relatório importado com sucesso!"
End Sub
Alguém poderia me ajudar?
-
@Basole deu certo! Muito obrigada!!!
Eu também gostaria de importar os dados do relatório gerado para outra planilha, mas não está funcionando.
Sub Importar_dados()
Dim importado As Excel.Workbook
Set importado = Workbooks.Open("C:\Users\User\Documents\Relatório\Report.xlsx", Password:="123")Application.ScreenUpdating = False
'Desbloquear guia e pasta de trabalho
ThisWorkbook.Unprotect ("123")
ActiveSheet.Unprotect ("123")'Limpar guia "Relatório"
Sheets("Dados").Visible = True
Sheets("Dados").Select
Selection.ClearContents'Importar relatório de dados
importado.Sheets("Relatório").CopyThisWorkbook.Sheets("Dados").Paste
importado.Close
'Bloquear guia e pasta de trabalho
ThisWorkbook.Protect Password:="123", Structure:=True, Windows:=FalseSheets("Contratos a Faturar").Protect Password:="123", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
UserInterfaceOnly:=True, _
AllowFormattingCells:=False, _
AllowFormattingColumns:=False, _
AllowFormattingRows:=True, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=True, _
AllowSorting:=False, _
AllowFiltering:=True, _
AllowUsingPivotTables:=FalseApplication.ScreenUpdating = True
MsgBox "Relatório importado com sucesso!"
End Sub
Alguém sabe o que pode estar acontecendo?
-
Prezados,
Desejo copiar dados de um intervalo de células, gerar outro arquivo de Excel e salvá-la em local específico.
Aparece "Erro em tempo de execução '1004' O método Select da classe Range falhou" quando tento executar o código.
Sub Salvar_dados()
'Copiar e colar como valores
Sheets("Base de Contratos").Range("B12:CN100000").Select Selection.Copy Application.DisplayAlerts = False Sheets("Relatório").Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Sheets("Base de Contratos").Activate
'Gerar relatório de dadosSheets("Relatório").Copy Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:="C:\Users\User\Documents\Relatório\" & "report" & "_" & Format(Now, "m.dd.yy hhmm") & ".xlsx" ActiveWorkbook.Close End Sub
Alguém poderia me ajudar?
Sobre o Clube do Hardware
No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais
Direitos autorais
Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais
Lançamento de contagem de parcelas
em Microsoft Office e similares
Postado
Bom dia,
Ainda sei pouco sobre VBA e preciso de ajuda para fazer um código que, a partir de um número especificado de parcelas, insira em outra guia todas as parcelas até chegar neste número.
Por exemplo:
Se eu adicionar em na guia inicial - Número de Parcelas: 10
Em outra guia, precisaria:
A1 = 1
A2 = 2
...
A10 = 10
Alguém poderia me auxiliar?