ppeterk

Veja este modelo! teste - Ppeterk.rar

Caso você pretenda utilizar esse método, é importante que nos informe o que quer unir. Qual valor com qual. O procv utiliza um dado em comum. O que você deseja que retorne na planilha 3?

Olá, boa tarde! Poste seu modelo para facilitar!

Veja este modelo! Quadro flutuante no Excel.rar

@CasaDoHardware Muito obrigado. A cada dia vocês do fórum me surpreendem. Agradeço mesmo, pois deu muito certo.

Galera, boa tarde! Preciso de uma ajuda. Tenho 3 Colunas de acordo com a imagem abaixo: Gostaria que o COMBOBOX1 fosse encadeado com o COMBOBOX2. O TEXTBOX1 aparecerá o nome referente ao COMBOBOX2. Obs: Confesso que todas as alternativas que busquei demonstravam códigos imensos. Agradeço se alguém puder me ajudar. Combobox.rar

Osvaldo, muito obrigado pelo retorno. Deu muito certo. Apenas não entendi muito bem sua dica. Gostaria de compreendê-la. Mas consegui o que pretendia. Obrigado mesmo.

Exemplo em anexo Materiais1.rar preciso muito da ajuda de vocês. Abraços

Galera, boa tarde! Coisa bem simples (eu imagino que seja simples) - Preciso preencher as células com quantidade - utilizando o formulário - considerando os critérios de matrícula (LINHA) e código do material (COLUNA) igual a imagem abaixo: É tipo batalha naval rsrs

CasaDoHardware, obrigado pelo retorno e desculpe se não expliquei bem. O código está certo. Acho que era melhor não postá-lo para não causar mais confusão. Em suma meu problema é: Não sei fazer uma macro que separa o arquivo de acordo com um critério (Critério esse que se encontra na coluna B). Só isso! De qualquer forma, eu fucei em alguns lugares e encontrei um código que me atende. Agradeço muito pela atenção. Segue o código que me atendeu: Dim i As Variant Dim aStrings(1 To 121) As Double 'variável contendo 121 variáveis aStrings(1) = 1001 aStrings(2) = 1002 aStrings(3) = 1003 aStrings(4) = 1004 aStrings(5) = 1007 aStrings(6) = 1008 aStrings(7) = 1009 aStrings(8) = 1010 aStrings(9) = 1011 aStrings(10) = 1012 aStrings(11) = 1013 aStrings(12) = 1014 aStrings(13) = 1015 aStrings(14) = 1016 aStrings(15) = 1017 aStrings(16) = 2001 aStrings(17) = 2002 aStrings(18) = 2003 aStrings(19) = 2004 aStrings(20) = 2005 aStrings(21) = 2006 aStrings(22) = 2007 aStrings(23) = 2008 aStrings(24) = 2009 aStrings(25) = 2010 aStrings(26) = 2013 aStrings(27) = 3001 aStrings(28) = 3002 aStrings(29) = 3003 aStrings(30) = 3004 aStrings(31) = 3005 aStrings(32) = 3006 aStrings(33) = 3007 aStrings(34) = 3008 aStrings(35) = 3009 aStrings(36) = 3010 aStrings(37) = 3011 aStrings(38) = 3012 aStrings(39) = 3013 aStrings(40) = 3014 aStrings(41) = 3015 aStrings(42) = 3016 aStrings(43) = 3017 aStrings(44) = 3018 aStrings(45) = 3019 aStrings(46) = 3020 aStrings(47) = 3021 aStrings(48) = 3022 aStrings(49) = 3023 aStrings(50) = 3024 aStrings(51) = 3025 aStrings(52) = 3026 aStrings(53) = 3027 aStrings(54) = 3028 aStrings(55) = 3029 aStrings(56) = 3030 aStrings(57) = 3031 aStrings(58) = 3032 aStrings(59) = 3033 aStrings(60) = 3034 aStrings(61) = 3035 aStrings(62) = 3036 aStrings(63) = 3037 aStrings(64) = 3038 aStrings(65) = 3039 aStrings(66) = 3045 aStrings(67) = 3051 aStrings(68) = 3052 aStrings(69) = 3053 aStrings(70) = 3054 aStrings(71) = 4001 aStrings(72) = 4002 aStrings(73) = 4003 aStrings(74) = 4005 aStrings(75) = 4006 aStrings(76) = 4007 aStrings(77) = 4008 aStrings(78) = 4009 aStrings(79) = 4010 aStrings(80) = 4011 aStrings(81) = 4012 aStrings(82) = 4013 aStrings(83) = 4014 aStrings(84) = 4015 aStrings(85) = 4016 aStrings(86) = 4017 aStrings(87) = 4018 aStrings(88) = 4019 aStrings(89) = 4020 aStrings(90) = 4021 aStrings(91) = 4022 aStrings(92) = 4023 aStrings(93) = 4024 aStrings(94) = 4025 aStrings(95) = 4026 aStrings(96) = 4027 aStrings(97) = 4028 aStrings(98) = 4029 aStrings(99) = 4030 aStrings(100) = 4031 aStrings(101) = 4032 aStrings(102) = 4033 aStrings(103) = 4034 aStrings(104) = 4035 aStrings(105) = 4036 aStrings(106) = 4038 aStrings(107) = 4039 aStrings(108) = 4040 aStrings(109) = 4041 aStrings(110) = 4042 aStrings(111) = 4043 aStrings(112) = 4044 aStrings(113) = 4045 aStrings(114) = 4046 aStrings(115) = 4047 aStrings(116) = 4048 aStrings(117) = 4049 aStrings(118) = 4050 aStrings(119) = 4051 aStrings(120) = 4053 aStrings(121) = 4054 For Each i In aStrings ' for para fazer fazer o loop de variável por variável Workbooks.Open nameFile 'abrir arquivo que ele deve realizar a macro Worksheets(1).Activate 'ativa a sheet1/aba1 Dim lRow As Long Dim lCount As Long Dim lLast As Long With Sheets(1) lLast = .Cells(.Rows.Count, "B").End(xlUp).Row 'percorre até a última linha For lRow = lLast To 2 Step -1 If .Cells(lRow, "B") <> i Then ' se diferente de i começa a apagar da última até a primeira .Rows(lRow).Delete lCount = lCount + 1 End If Next lRow End With Worksheets(2).Activate 'ativa a sheet2/aba2 Dim lRow1 As Long Dim lCount1 As Long Dim lLast1 As Long With Sheets(2) lLast1 = .Cells(.Rows.Count, "B").End(xlUp).Row 'percorre até a última linha For lRow1 = lLast1 To 2 Step -1 If .Cells(lRow1, "B") <> i Then ' se diferente de i começa a apagar da última até a primeira .Rows(lRow1).Delete lCount1 = lCount1 + 1 End If Next lRow1 End With ActiveWorkbook.SaveAs Filename:= _ 'localFile: Local que o usuário escolheu - varTexto: Nome que o usuário deseja localFile & "\" & varTexto & " - " & Range("A2").Text & " - " & Range("C2").Text & ".xlsx" ActiveWorkbook.Close savechanges:=True Application.DisplayAlerts = False 'Subistituir sem dó Next i

Alguém?

Consegui fazer da forma que me atende. Segue o código para caso alguém necessite: Sub importar () Dim File_Names As Variant Dim File_count As Integer Dim Active_File_Name As String Dim Counter As Integer Dim File_Save_Name As Variant File_Names = Application.GetOpenFilename(, , , , True) File_count = UBound(File_Names) Counter = 1 Do Until Counter > File_count Active_File_Name = File_Names(Counter) Workbooks.Open Filename:=Active_File_Name Active_File_Name = ActiveWorkbook.Name File_Save_Name = InStr(1, Active_File_Name, ".txt", 1) File_Save_Name = Mid(Active_File_Name, 1, File_Save_Name) & ".xlsx" ActiveWorkbook.Save ActiveWorkbook.SaveAs Filename:= _ File_Save_Name, FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Counter = Counter + 1 Loop ' import excel file Dim importFileName As Variant Dim importWorkbook As Workbook Dim importSheet As Worksheet Dim importRange As Range ' show open file dialog importFileName = File_Save_Name ' if user pressed cancel buton: exit If importFileName = False Then Exit Sub Application.ScreenUpdating = False ' if user selected a excel file, open it Set importWorkbook = Application.Workbooks.Open(importFileName) Set importSheet = importWorkbook.Worksheets(1) ' copy from import sheet Set importRange = importSheet.Range( _ importSheet.Range("A1"), _ importSheet.Range("J" & importSheet.Rows.Count).End(xlUp) _ ) importRange.Copy ' paste into Data sheet Windows("MacroEventos.xlsm").Activate Sheets("13ADM").Select Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False importWorkbook.Close End sub

Galera, tudo bem? Tenho esse código abaixo que inicialmente faz o que eu quero. Ele abre o arquivo TXT em excel. O erro está dando na hora de salvar o arquivo em XLSX. Não pedindo muito (rsrs), mas gostaria também de, após salvar esse TXT em XLSX o usuário, através de um botão, importasse esse arquivo para o arquivo ativo escolhendo a sheet desejada. Obrigado Sub Convert_Csv() Dim File_Names As Variant Dim File_count As Integer Dim Active_File_Name As String Dim Counter As Integer Dim File_Save_Name As Variant File_Names = Application.GetOpenFilename(, , , , True) File_count = UBound(File_Names) Counter = 1 Do Until Counter > File_count Active_File_Name = File_Names(Counter) Workbooks.Open Filename:=Active_File_Name Active_File_Name = ActiveWorkbook.Name File_Save_Name = InStr(1, Active_File_Name, ".txt", 1) File_Save_Name = Mid(Active_File_Name, 1, File_Save_Name) & ".xlsx" ActiveWorkbook.Save ActiveWorkbook.SaveAs Filename:=File_Save_Name, FileFormat:=xlOpenXMLWorkbooklocal ActiveWindow.Close Counter = Counter + 1 Loop End Sub

Amigos, bom dia! Preciso muito da ajuda de vocês. Procurei, mas não encontrei algo que eu conseguisse adaptar. Vamos lá: Eu preciso de um código que simplesmente filtre um dado em comum em todas as abas/sheets do arquivo e depois salve. Retorna novamente e filtre o próximo dado em comum de todas as abas/sheets e salva. (Exemplo: Na coluna B da aba1/sheet1 tem o código "1001", assim como na aba2/sheet2 tem, também, na coluna B o código 1001 e assim vai) Tenho esse código abaixo que o usuário cria um arquivo excel e atrela a macro a um botão e, quando ele clica no botão, acontece o seguinte: 1 - Solicita o usuário o arquivo que ele quer realizar esses filtros em todas a abas. 2 - O local onde ele quer salvar todos os arquivos que serão geradas ao filtrar código por código (Exemplo: realiza o filtro com o código 1001 da coluna B de todas as abas/sheets; esse arquivo com os dados do código 1001 terá um nome. Quando realizar o filtro com o código 1002 uma novo arquivo com um novo nome surgirá). 3 - Peço o usuário para digitar o nome padrão/inicial que ele quer para todas os arquivos que serão geradas (Digo isso, pois eu peço para completar o nome com um conteúdo em uma Range) 4 - Por fim, e mais importante, ao dar OK esse LOOP dos filtros deverá iniciar (Aqui que eu preciso da ajuda de vocês). 'FUNÇÃO PARA ABRIR O ARQUIVO QUE ELE QUER Public Function OpenFileDialog() As String Dim Filter As String, Title As String Dim FilterIndex As Integer Dim Filename As Variant ' Define o filtro de procura dos arquivos Filter = "Arquivos Excel (*.xlsx),*.xlsx," ' O filtro padrão é *.* FilterIndex = 3 ' Define o Título (Caption) da Tela Title = "Selecione um arquivo" ' Define o disco de procura ChDrive ("S") ChDir ("S:\") With Application ' Abre a caixa de diálogo para seleção do arquivo com os parâmetros Filename = .GetOpenFilename(Filter, FilterIndex, Title) ' Reseta o Path ChDrive (Left(.DefaultFilePath, 1)) ChDir (.DefaultFilePath) End With ' Abandona ao Cancelar If Filename = False Then MsgBox "Nenhum arquivo foi selecionado." Exit Function End If ' Retorna o caminho do arquivo OpenFileDialog = Filename End Function '-------------------------------------------------------------------------------------------------------------------------- 'FUNÇÃO PARA SELECIONAR O CAMINHO Function localizarCaminho() Dim strCaminho As String With Application.FileDialog(msoFileDialogFolderPicker) 'Permitir mais de uma pasta .AllowMultiSelect = False 'Mostrar janela .Show If .SelectedItems.Count > 0 Then strCaminho = .SelectedItems(1) End If End With 'Atribuir caminho a variável modFileBrowser = strCaminho localizarCaminho = modFileBrowser End Function '-------------------------------------------------------------------------------------------------------------------------- Sub Retângulo1_Clique() 'PLANILHA QUE ELE QUER MsgBox "Selecione a planilha a ser quebrada" nameFile = OpenFileDialog() 'LOCAL QUE ELE QUER MsgBox "Selecione o local a ser gravado" localFile = localizarCaminho() MsgBox localFile 'ESCOLHE O NOME QUE ELE QUER varTexto = InputBox("Exemplo: 'Orçado x Realizado 01 2018'", "Nome padrão para planilhas") '-------------------------------------------------------------------------------------------------------------------------- 'AQUI COMEÇA O LOOP EM CADA SHEET Workbooks.Open nameFile Worksheets(1).Activate 'Ex: Apaga tudo e deixa apenas o código 1001 da coluna B Worksheets(2).Activate 'Ex: Apaga tudo e deixa apenas o código 1001 da coluna B Worksheets(3).Activate 'Ex: Apaga tudo e deixa apenas o código 1001 da coluna B Worksheets(4).Activate 'Ex: Apaga tudo e deixa apenas o código 1001 da coluna B Worksheets(5).Activate 'Ex: Apaga tudo e deixa apenas o código 1001 da coluna B Worksheets(6).Activate 'Ex: Apaga tudo e deixa apenas o código 1001 da coluna B 'AQUI SALVA COM O NOME INICIAL QUE ELE COLOCOU E O RESTO EU DIGO QUE É PARA COMPLETAR COM A RANGE C2 ActiveWorkbook.SaveAs Filename:= _ varTexto & " - " & Range("A2").Text & " - " & Range("C2").Text & ".xlsx" ActiveWorkbook.Close savechanges:=True Application.DisplayAlerts = True End Sub Obs: Coloquei em anexo um exemplo de arquivo que em todas as abas/sheets, na coluna B, tem código em comum (1001, 1002, 1003, 1004). Planilha para Filtrar e Salvar.xlsx