Página 1 de 1

extração de informação de dois relatórios para um ficheiro principal

Enviado: 31 Mai 2022 às 19:06
por atcgfc
Boas,

Tenho um ficheiro de relatório principal que extraio uma série de erros que sucedem todos os dias no processo noturno.

Nesse processo geram dois ficheiros com erros - criei duas macros (denominadas: extração ficheiro 1 e extração ficheiro 2), para abrir o ficheiro e copiar para o meu documento excel.

A primeira macro funciona bem, apesar de dar um erro no fim e a segunda macro não cola na primeira linha disponível.

Envio os ficheiros em anexo para se for possível alguém verificar porquê que não está a funcionar.

Primeira macro
Código: Selecionar todos
Sub SAP_EC_Ficheiro1()

Dim caminho As Variant
Dim ficheiro_sap As Workbook, ficheiro_excel As Workbook

caminho = Application.GetOpenFilename

If caminho = False Then Exit Sub

Workbooks.Open caminho, , True
Set ficheiro_excel = ThisWorkbook
Set ficheiro_sap = ActiveWorkbook

ficheiro_sap.Sheets(1).Columns(4).Delete
ficheiro_sap.Sheets(1).Columns(2).Delete
ficheiro_sap.Sheets(1).Columns(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete

Folha1.Range("A12").PasteSpecial = ficheiro_sap.Sheets(1).Range("A1").CurrentRegion.Copy

Application.CutCopyMode = False

End Sub
Segunda macro
Código: Selecionar todos
Sub SAP_EC_Ficheiro2()

Dim caminho As Variant
Dim ficheiro_sap As Workbook, ficheiro_excel As Workbook

caminho = Application.GetOpenFilename

If caminho = False Then Exit Sub

Workbooks.Open caminho, , True
Set ficheiro_excel = ThisWorkbook
Set ficheiro_sap = ActiveWorkbook

ficheiro_sap.Sheets(1).Columns(4).Delete
ficheiro_sap.Sheets(1).Columns(2).Delete
ficheiro_sap.Sheets(1).Columns(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete
ficheiro_sap.Sheets(1).Rows(1).Delete

linha = Range("a1048576").End(xlUp).Row + 1

Folha1.Cells(linha, 1).Paste = ficheiro_sap.Sheets(1).Range("A1").CurrentRegion.Copy

Application.CutCopyMode = False

'Testes_ficheiros.Range("A12").PasteSpecial

End Sub

Cumprimentos,

Re: extração de informação de dois relatórios para um ficheiro principal

Enviado: 01 Jun 2022 às 03:51
por atcgfc
@osvaldomp consegue ajudar-me sff ?

Cumprimentos ,

Re: extração de informação de dois relatórios para um ficheiro principal

Enviado: 01 Jun 2022 às 20:04
por osvaldomp
No primeiro código substitua esta linha
Folha1.Range("A12").PasteSpecial = ficheiro_sap.Sheets(1).Range("A1").CurrentRegion.Copy

por esta
ficheiro_sap.Sheets(1).Range("A1").CurrentRegion.Copy ficheiro_excel.Sheets("Folha1").Range("A12")

#
No segundo código substitua estas duas linhas
linha = Range("a1048576").End(xlUp).Row + 1
Folha1.Cells(linha, 1).Paste = ficheiro_sap.Sheets(1).Range("A1").CurrentRegion.Copy


por estas
linha = ficheiro_excel.Sheets("Folha1").Cells(Rows.Count, 1).End(3).Row + 1
ficheiro_sap.Sheets(1).Range("A1").CurrentRegion.Copy ficheiro_excel.Sheets("Folha1").Cells(linha, 1)

#
dicas (valem para os dois códigos):
1. ao invés de deletar 13 vezes a linha 1 , delete as linhas 1 a 13 ~~~> ficheiro_sap.Sheets(1).Rows("1:13").Delete
2. acrescente a linha em vermelho, conforme abaixo.
Dim ficheiro_sap As Workbook, ficheiro_excel As Workbook
Application.ScreenUpdating = False

Re: extração de informação de dois relatórios para um ficheiro principal

Enviado: 02 Jun 2022 às 04:49
por atcgfc
Funcionou perfeitamente.

Muito obrigado Osvaldo pelas dicas, és uma máquina.

Cumprimentos,

Álvaro