Configuração Código VBA

[APKAT]

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.