Boa tarde, cts
Alguns adendos referente este Fórum e aos Tópicos que você abre:
- 1º quando abrir um tópico, por gentileza não abandoná-lo; caso já tenha resolvido a sua questão
informe no seu Tópico e coloque o resultado; pois muitos usuários podem precisar pesquisar
e até mesmo utilizá-lo (pois a mesma dúvida pode ser igual ou parecida a de outros). Para
exemplo me refiro ao Tópico que tu abriste e deixou abandonado sem resposta, segue abaixo o link:
http://www.planilhando.com.br/forum/viewtopic.php?f=10&t=32185
- 2º Sempre agradeça o pessoal que está tentando te ajudar (clicando na mãozinha), mesmo que não
resolva por completo, pois todos aqui só fazemos isso em nosso tempo livre, e com os agradecimentos
nos incentiva a continuar ajudando ;
- 3º Como já tinha mencionado anteriormente (como no tópico acima citado) veja a observação em azul
abaixo:
Como todos aqui, temos compromissos e não temos muito tempo para criar um arquivo do zero, pois
ajudamos somente no nosso tempo livre... é muito importante sempre anexar uma planilha de
exemplo com dados (fictícios) e que não seja o projeto inteiro ; explicando com as informações
necessárias para alcançar o seu objetivo, desta forma podemos ajudá-lo com maior rapidez e
eficácia (a maioria nem olharia este Tópico sem um arquivo exemplo, pois existe muitas
"variáveis" que podem impossibilitar o sucesso parcial ou total da solução proposta,se não tiver um
arquivo exemplo que for disponibilizado) 😉 ..
Como tu não colocou um arquivo exemplo (sempre informe um), estou informando alguns códigos que podem te
ajudar no desenvolvimento do seu projeto que citou na mensagem acima (terá que adaptá-los ao seu projeto):
Abaixo código que abre o arquivo Excel usando a janela do navegador no endereço "BibliotecasDocumentos";
pode ser colocado em um módulo:
Sub AbreArquivo1()
Dim xFilePath As String
Dim xObjFD As FileDialog
Set xObjFD = Application.FileDialog(msoFileDialogFilePicker)
With xObjFD
.AllowMultiSelect = False
.Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm; *.xlsb", 1
.Show
If .SelectedItems.Count > 0 Then
xFilePath = .SelectedItems.Item(1)
Else
Exit Sub
End If
End With
Workbooks.Open xFilePath 'aqui abre o arquivo selecionado
End Sub
Agora abaixo o código que abre um inputbox, tu digita a letra da coluna + a linha que
quer selecionar e ele já copia a seleção e cola no arquivo excel "C:Arquivos Copiados - 2019-12.xlsx"
(este é só um exemplo - crie um arquivo para a colagem dos dados selecionados - e este cola sempre
abaixo da última linha preenchida) - este código está integrado a um commandbutton criado no arquivo
Excel Principal (que não contém nenhum dados é somente para executar os comandos de seleção, copia e
de abrir outros arquivos Excel e salvar no arquivo Excel que irá gravar os seus dados):
Private Sub CommandButton1_Click()
Dim x As Variant
Dim WNew As Workbook
Dim wsc As Workbook
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
' ********************************************
Call AbreArquivo1
On Error Resume Next
Set WNew = ActiveWorkbook
Set WNew = ActiveSheet
'**********************************************************
Set x = Application.InputBox _
(Prompt:="- Escolha as linhas, " & _
"selecionando-as." & vbCrLf & vbCrLf & "Pode-se escolher várias linhas " & _
"- Para selecionar mais de uma linha, " & vbCrLf & _
"digite a coluna com o nº da linha colocando ponto e virgula" & vbCrLf & _
"digitando na sequencia a próxima coluna com o nº da linha, " & vbCrLf & _
"e assim por diante. ", _
Title:=SELEÇÃO, Type:=8)
If Not x Is Nothing Then
MsgBox "As linhas foram selecionadas e serão coladas!" & vbCrLf & _
x.Address, vbExclamation, msgTitulo
x.EntireRow.Select
x.EntireRow.Copy
' ******************************************
Set wsc = Workbooks.Open("C:Arquivos Copiados - 2019-12.xlsx")
wsc.Sheets(1).Select
wsc.Sheets(1).Range("A1").Select
Do
If Not (IsEmpty(ActiveCell)) Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True
ActiveCell.PasteSpecial Paste:=xlValues
Application.DisplayAlerts = False
wsc.SaveAs WNew.Path & "Arquivos Copiados - " & Year(Date) & "-" & Month(Date)
wsc.Close savechanges = True
Application.DisplayAlerts = True
End If
' *********************************************
Application.CutCopyMode = False
Set x = Nothing
Set WNew = Nothing
Set wsc = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Com esses códigos tu podes abrir quantos arquivos Excel quiser e selecionar as linhas que desejar
copiar para o arquivo Excel de "Destino"
Por gentileza, verifique se está de acordo com o que solicitou
Qualquer dúvida estamos aqui para ajudar
Aguardando sua resposta e seu Feed Back(é muito importante)... se foi útil, não esqueça de clicar na "mãozinha"
LaerteB
Postado : 17/12/2019 3:09 pm