Jump to content
Fórum Script Brasil
  • 0
Sign in to follow this  
APKAT

Configuração Código VBA

Question

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.

 

 

 

 

Capturar.PNG

Share this post


Link to post
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this  



  • Forum Statistics

    • Total Topics
      148409
    • Total Posts
      643822
×
×
  • Create New...