Este fórum está sendo desativado

[brumoal]

Olá gente boa!
Sou novato por aqui e também em programação em VBA.
Gostaria muito de contar com a ajuda dos senhores(as)!

Estou precisando de um código que ao clicar em um determinado botão (serão 30 no total), abra a opção para realizar a importação de uma outra planilha que estará na minha rede (é importante que o arquivo seja selecionado de qualquer diretório).
Essa planilha que será importada terá um padrão definido (por exemplo, a célula A1 terá o mesmo nome do botão, esse dado deverá ser checado, e os dados a serem copiados estarão na range "A6:S56" da sheet com mesmo nome). Tudo em valores (texto e números).

Ao terminar a importação, seria importante retornar uma mensagem (sucesso ou falha caso não seja a planilha padrão) e também ter um "ok" ao lado do botão.

Até a parte de selecionar a planilha a ser importada eu consegui fazer (contando com a ajuda aqui do fórum em tópicos parecidos), depois disso faltou conhecimento.



Usei esse código para abrir a caixa e tentei ligar com um outro para copiar... não deu certo.

Sub Import()
Dim File As String
Dim FileToOpen
FileToOpen = Application.GetOpenFilename _
(Title:="Selecione o arquivo a ser importado", _
FileFilter:="Text Files *.xlsx (*.xlsx),")
File = FileToOpen
If FileToOpen = False Then
MsgBox "Você clicou em cancelar. Especifique um Arquivo.", vbExclamation
Exit Sub
Else: ImpTextFile FName:=File, Sep:="|"
End If
End Sub



Esse outro seria o código para copiar... furado! Aqui eu fui misturando tudo...

Function ImpTextFile(FName As String, Sep As String)

Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer

D1_.Activate
Range("A1:S57").ClearContents
D1_.Cells(1, 1).Select

Application.ScreenUpdating = False

On Error GoTo EndMacro:
SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row

Open FName For Input Access Read As #1

While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
End Function


Alguém consegue me salvar?

[DJunqueira]

Não estou bem certo se é o caso, mas vc mencionou a possibilidade de importar 30 planilhas, aí eu pergunto, vc sabe q o Excel pode importar todas as planilhas de uma determinada pasta de trabalho de uma vez?
E q essa importação é ainda melhor realizada se utilizar Nova Consulta / Power Query?

[brumoal]

Obrigado pela sua atenção e tempo dispensado em me ajudar.
Sobre a questão que falou, sei sim.
Esse caso porém, preciso deixar a possibilidade de importar 30 planilhas de forma individual. Trata-se de uma planilha de simulação. Então a possibilidade de não importaR determinada planilha deve ser considerada.

Após inserir minha dúvida aqui, já evolui bastante. Ja consegui fechar um código bacana. Está pendente apenas de detalhes para deixar mais limpa.

[DJunqueira]

Ótimo, sucesso então

[osvaldomp]

@brumoal

Experimente o código abaixo.

Código: Selecionar todos

Sub Import()

 Dim File As String, botão As String, wsO As Worksheet, wsD As Worksheet
 Dim FileToOpen, LR As Long
  botão = ActiveSheet.Buttons(Application.Caller).Caption
  Set wsD = ThisWorkbook.Sheets(botão)
  FileToOpen = Application.GetOpenFilename _
  (Title:="Selecione o arquivo a ser importado", _
  FileFilter:="Text Files *.xlsx (*.xlsx),")
  
  If FileToOpen = False Then
   MsgBox "Você clicou em cancelar. Especifique um Arquivo.", vbExclamation
   Exit Sub
  End If
  Application.ScreenUpdating = False
  Set wsO = Workbooks.Open(FileToOpen).ActiveSheet
  If wsO.[A1] <> botão Then MsgBox "arquivo não corresponde ao botão clicado": Exit Sub
    LR = wsO.Cells(Rows.Count, 1).End(3).Row
    wsD.[A4].Resize(LR - 3, 19).Value = wsO.Range("A4:S" & LR).Value
  'ActiveWorkbook.Close
  Application.ScreenUpdating = True
  MsgBox "concluído"
End Sub

obs.
1. considerei que o arquivo de origem dos dados tem uma única planilha (seu nome não importa)
2. considerei que o texto do botão, o nome da planilha destino e o conteúdo de 'A1' da planilha origem serão iguais; no seu exemplo está assim:
texto no botão ---> D01
A1 ---> D1
nome da planilha ---> D1_
então escolha um deles e altere os outros dois (sugiro D01)
3. não coloquei ainda no código o comando para marcar a TexBox ao lado do botão clicado
4. este código não utiliza a Function ImpTextFile, se você quiser pode removê-la

[brumoal]

Osvaldo! Muito boa tarde!

Eu já tinha feito um outro código e desistido kkk

Ficou perfeito!!

Agora, se não for abusar de sua boa vontade e conhecimento, seria possível incluir uma forma de fechar a planilha "não corresponde ao botão clicado"?

[osvaldomp]

Coloque esta linha no lugar.

Código: Selecionar todos

If wsO.[A1] <> botão Then MsgBox "arquivo não corresponde ao botão clicado": ActiveWorkbook.Close: Exit Sub

[brumoal]

Coloque esta linha no lugar.

Código: Selecionar todos

If wsO.[A1] <> botão Then MsgBox "arquivo não corresponde ao botão clicado": ActiveWorkbook.Close: Exit Sub

Olá Osvaldo!!

O código ficou perfeito!
Muito obrigado!!