Ir ao conteúdo
  • Cadastre-se

Jéssica De Moura Lima

Membro Júnior
  • Posts

    6
  • Cadastrado em

  • Última visita

Reputação

0
  1. 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?
  2. 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" Then Range("D17").Value = 0 Range("D17:D18").Select Selection.EntireRow.Hidden = True Range("D11").Select ElseIf Range("D11").Value = "Aditivo" Then Rows("17:18").Select Selection.EntireRow.Hidden = False Range("D17").Select End If ActiveSheet.Protect Password:="12345" End Sub Alguém poderia me ajudar?
  3. 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 Long Set 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 If Loop 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 = True MsgBox "Faturamento registrado com sucesso!" End Sub
  4. 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 Worksheet Abrir = 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 = True With 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:=False Sheets("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:=False Application.ScreenUpdating = True MsgBox "Relatório importado com sucesso!" End Sub Alguém poderia me ajudar?
  5. @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").Copy ThisWorkbook.Sheets("Dados").Paste importado.Close 'Bloquear guia e pasta de trabalho ThisWorkbook.Protect Password:="123", Structure:=True, Windows:=False Sheets("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:=False Application.ScreenUpdating = True MsgBox "Relatório importado com sucesso!" End Sub Alguém sabe o que pode estar acontecendo?
  6. 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 dados Sheets("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

×
×
  • Criar novo...