Este fórum está sendo desativado

[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,

[atcgfc]

@osvaldomp consegue ajudar-me sff ?

Cumprimentos ,

[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

[atcgfc]

Funcionou perfeitamente.

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

Cumprimentos,

Álvaro