Alteração Código VB...
 
Notifications
Clear all

Alteração Código VBA Importação

3 Posts
2 Usuários
0 Reactions
1,059 Visualizações
(@ericksant)
Posts: 109
Estimable Member
Topic starter
 

Prezados,
bom dia,

Seguindo o código para importar mais de uma planilha para um único arquivo:

Option Explicit

Private Sub btImporta_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

'Captura arquivo para tratamento
'-------------------------------

ArqParaAbrir = Application.GetOpenFilename("Arquivo de Retorno (*.*), *.*", Title:="Escolha o arquivo a ser importado", MultiSelect:=True)

If Not IsArray(ArqParaAbrir) Then

    If ArqParaAbrir = "" Or ArqParaAbrir = False Then
        MsgBox "Processo abortado. Não foi selecionado arquivos para processar...", vbOKOnly, "Processo abortado"
        Exit Sub
    End If

End If

Set W = Sheets("Plan1")

W.UsedRange.EntireColumn.Delete
W.Select
  
For a = LBound(ArqParaAbrir) To UBound(ArqParaAbrir)
    
    NomeArquivo = ArqParaAbrir(a)
    
    Application.Workbooks.Open (NomeArquivo)
    Set WNew = ActiveWorkbook
    ActiveSheet.Range("A1").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", vbOKOnly, "Processo concluído"


End Sub

Se rodarem este código, irão verificar que o conteúdo copiado é colado a partir da célula A2, eu queria de alguma forma editar para ser colado diretamente na célula A1...

Alguém consegue me ajudar ?

 
Postado : 19/06/2018 9:24 am
(@rafaelp)
Posts: 89
Trusted Member
 

Bom dia.

ericksant,

Veja se lhe atende:

Option Explicit

Private Sub btImporta_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

'Captura arquivo para tratamento
'-------------------------------

ArqParaAbrir = Application.GetOpenFilename("Arquivo de Retorno (*.*), *.*", Title:="Escolha o arquivo a ser importado", MultiSelect:=True)

If Not IsArray(ArqParaAbrir) Then

    If ArqParaAbrir = "" Or ArqParaAbrir = False Then
        MsgBox "Processo abortado. Não foi selecionado arquivos para processar...", vbOKOnly, "Processo abortado"
        Exit Sub
    End If

End If

Set W = Sheets("Plan1")

W.UsedRange.EntireColumn.Delete
W.Select
  
For a = LBound(ArqParaAbrir) To UBound(ArqParaAbrir)
    
    NomeArquivo = ArqParaAbrir(a)
    
    Application.Workbooks.Open (NomeArquivo)
    Set WNew = ActiveWorkbook
    ActiveSheet.Range("A1").CurrentRegion.Select
    Selection.Copy Destination:=W.Cells(W.Rows.Count, 1).End(xlUp).Offset(0, 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", vbOKOnly, "Processo concluído"


End Sub
 
Postado : 19/06/2018 9:46 am
(@ericksant)
Posts: 109
Estimable Member
Topic starter
 

Funcionou!

Obrigado cara!

 
Postado : 19/06/2018 11:21 am