IMPORTA DADOS DE UMA PLANILHA SELECIONADA
Enviado: 30 Mar 2022 às 03:57
MACRO ESTA DANDO ERRO NA HORA DE IMPORTA OS DADOS
Sub Importar_Dados()
On Erro GoTo Erro
Application.ScreenUpdating = False
Dim Guia As Object
Dim Planilha As Workbook
Dim enderecoPlan As String
Dim Coluna As Double, Linha As Double, ColDestino As Double
enderecoPlan = Application.GetOpenFilename(FileFilter:="file, *.xls*")
If enderecoPlan <> Empty And enderecoPlan <> "Falso" Then
Set Planilha = Application.Workbooks.Open(enderecoPlan)
Else
Application.ScreenUpdating = True
Exit Sub
End If
Set Guia = Planilha.Worksheets(1)
Windows(Planilha.Name).Visible = False
Colunas = 1
Linhas = 1
Inicio:
Do
Linha = Linha + 1
If Guia.Cells(Linha, Coluna).Value <> Empty Then
LinOrigem = Linha
ColInicial = Coluna
Do
Coluna = Coluna + 1
Loop Until Guia.Cells(Linha, Coluna).Value = Empty
ColFinal = Coluna - 1
Exit Do
End If
If Coluna = 100 Then
MsgBox "N�o encontrado cabe�alho!", vbExclamation, "IMPORTAR"
Exit Sub
End If
Loop Until Linha = 10
If LinOrigem = Empty Then
Coluna = Coluna + 1
Linha = 1
GoTo Inicio:
End If
Coluna = ColInicial
ColDestino = 2
Linha = WorksheetFunction.CountA(Panilhal.Range("A:A")) + 2
With Planilhal
Do
LinOrigem = LinOrigem + 1
For Coluna = ColInicial To ColFinal
.Cells(Linha, ColDestino).Value = Guia.Cells(LinOrigem, Coluna).Value
ColDestino = ColDestino + 1
Next Coluna
ColDestino = 1
Linha = Linha + 1
Loop Until Guia.Cells(LinOrigem, ColInicial).Value = Empty
End With
Windows(Planilha.Name).Visible = True
Application.DisplayAlerts = False
Windows(Planilha.Name).Close
Application.DisplayAlerts = True
Set Planilha = Nothing
Set Guia = Nothing
Application.ScreenUpdating = True
Exit Sub
Erro:
MsgBox "Erro!", vbCritical, "IMPORTA"
End Sub
Sub Importar_Dados()
On Erro GoTo Erro
Application.ScreenUpdating = False
Dim Guia As Object
Dim Planilha As Workbook
Dim enderecoPlan As String
Dim Coluna As Double, Linha As Double, ColDestino As Double
enderecoPlan = Application.GetOpenFilename(FileFilter:="file, *.xls*")
If enderecoPlan <> Empty And enderecoPlan <> "Falso" Then
Set Planilha = Application.Workbooks.Open(enderecoPlan)
Else
Application.ScreenUpdating = True
Exit Sub
End If
Set Guia = Planilha.Worksheets(1)
Windows(Planilha.Name).Visible = False
Colunas = 1
Linhas = 1
Inicio:
Do
Linha = Linha + 1
If Guia.Cells(Linha, Coluna).Value <> Empty Then
LinOrigem = Linha
ColInicial = Coluna
Do
Coluna = Coluna + 1
Loop Until Guia.Cells(Linha, Coluna).Value = Empty
ColFinal = Coluna - 1
Exit Do
End If
If Coluna = 100 Then
MsgBox "N�o encontrado cabe�alho!", vbExclamation, "IMPORTAR"
Exit Sub
End If
Loop Until Linha = 10
If LinOrigem = Empty Then
Coluna = Coluna + 1
Linha = 1
GoTo Inicio:
End If
Coluna = ColInicial
ColDestino = 2
Linha = WorksheetFunction.CountA(Panilhal.Range("A:A")) + 2
With Planilhal
Do
LinOrigem = LinOrigem + 1
For Coluna = ColInicial To ColFinal
.Cells(Linha, ColDestino).Value = Guia.Cells(LinOrigem, Coluna).Value
ColDestino = ColDestino + 1
Next Coluna
ColDestino = 1
Linha = Linha + 1
Loop Until Guia.Cells(LinOrigem, ColInicial).Value = Empty
End With
Windows(Planilha.Name).Visible = True
Application.DisplayAlerts = False
Windows(Planilha.Name).Close
Application.DisplayAlerts = True
Set Planilha = Nothing
Set Guia = Nothing
Application.ScreenUpdating = True
Exit Sub
Erro:
MsgBox "Erro!", vbCritical, "IMPORTA"
End Sub