Ir para conteúdo
Fórum Script Brasil

APKAT

Membros
  • Total de itens

    1
  • Registro em

  • Última visita

Sobre APKAT

APKAT's Achievements

0

Reputação

  1. Boa tarde! 😀 Estou utilizando um código VBA para consolidação de planilhas afim de enviar um relatório semanal. Preciso de ajuda pois o código está buscando os dados certos, porém eu não preciso que me retorne a planilha inteira e sim apenas da A6 até a coluna E6 em todas as planilhas, e apenas os dados contidos, não precisa vim a formatação original pois se preciso for, formato depois do jeito que eu precisar. Tentei usar o Offset mas está dando erro "tempo de execução 9". Em anexo coloquei o print do modelo da planilha que será consolidada. Código Utilizado: Option Explicit Private Sub btExecuta_Click() Application.ScreenUpdating = False 'Definição das variáveis '-------------------------------------- Dim W As Worksheet Dim WNew As Workbook Dim ArqParaAbrir As Variant Dim A As Integer Dim NomeArquivo As String 'Capturar arquivos para tratamento '--------------------------------------- ArqParaAbrir = Application.GetOpenFilename("Arquivo do Excel (*.xlsm), *.xl*", _ Title:="Escolha o arquivo a ser importado", _ MultiSelect:=True) If Not IsArray(ArqParaAbrir) Then If ArqParaAbrir = "" Or ArqParaAbrir = False Then MsgBox "Processo abortado, nenhum arquivo escolhido", vbOKOnly, "Processo abortado" Exit Sub End If End If 'Começa a importação dos dados '------------------------------------- Set W = Sheets("CONSOLIDADO") W.UsedRange.EntireColumn.Delete W.Select 'Loop para importação dos arquivos '-------------------------------------- For A = LBound(ArqParaAbrir) To UBound(ArqParaAbrir) NomeArquivo = ArqParaAbrir(A) Application.Workbooks.Open (NomeArquivo) Set WNew = ActiveWorkbook ActiveSheet.Range("a6").CurrentRegion.Select Selection.Copy Destination:=W.Cells(W.Rows.Count, 1).End(xlUp).Offset(1, 0) Application.DisplayAlerts = False ActiveWorkbook.Close savechanges:=False Application.DisplayAlerts = True W.Cells(W.Rows.Count, 1).End(xlUp).Offset(1, 0).Select Next A Application.ScreenUpdating = True MsgBox "Processo concluído. Arquivos copiados..." End Sub **** Desde já agradeço.
×
×
  • Criar Novo...