Excel VBA - selecionando colunas não adjacentes por nome

[isabela queiroz]

precisava selecionar algumas colunas em uma planilha e precisava que fosse localizado pelo nome das colunas não pela celula ja que pode varias a localização delas, gostaria de selecionar, por exemplo, 6 colunas não adjacentes e coloca-las em outro sheet.

 

 

[Scofieldgyn]

@isabela queiroz

 

Veja se o código abaixo te atende.

Sub EnderecoColCabeçalho()
'Macro pra copiar uma coluna pelo nome do cabeçalho
    Dim xRg As Range
    Dim xRgUni As Range
    Dim xFirstAddress As String
    Dim xStr As String
    On Error Resume Next
    xStr = "Nome Cabeçalho" 'Coloque o nome do cabeçalho da coluna que deseja copiar
    Set xRg = Range("A1:D1").Find(xStr, , xlValues, xlWhole, , , True)
    If Not xRg Is Nothing Then
        xFirstAddress = xRg.Address
        Do
            Set xRg = Range("A1:D1").FindNext(xRg)
            If xRgUni Is Nothing Then
                Set xRgUni = xRg
            Else
                Set xRgUni = Application.Union(xRgUni, xRg)
            End If
        Loop While (Not xRg Is Nothing) And (xRg.Address <> xFirstAddress)
    End If
    xRgUni.EntireColumn.Copy
End Sub

 

[isabela queiroz]

@Scofieldgyn fiz aqui e não aconteceu nada, a coluna que quero começa na celula "B12", isso faz alguma diferença?

[Scofieldgyn]

@isabela queiroz

 

7 minutos atrás, isabela queiroz disse:

@Scofieldgyn fiz aqui e não aconteceu nada, a coluna que quero começa na celula "B12", isso faz alguma diferença?

B12 de qual aba? você não foi tão específico, então segui conforme os gráficos da fonte que puxa os dados.

 

em anexo um exemplo.

Demonstrativo De Saldos 2022 (Em Andamento).zip

[isabela queiroz]

@Scofieldgyn Eu fiz uma tabela de exemplo pra ficar mais fácil de explicar, tem o excel "EXEMPLO.xlsx" com o "sheet1" com as infos na tabela, precisava que, por exemplo, as colunas "tipo, marca, genero e quantidade" fossem colados no "sheet1" de outo excel, ex. "EXEMPLO2.xlsx" 

 

EXEMPLO.xlsx

[Scofieldgyn]

@isabela queiroz Confundi e acabei colocando um exemplo de uma dúvida de outro usuário, ignore esse excel que te enviei.

 

Em relação a sua solicitação.  código que coloqudi inicialmente vai te atender, o que você vai precisar é mudar a referência da localicação do cabeçalho conforme abaixo. Ressalvo que o código termina na coluna sendo copiada, ai você insere o restante da rotina que deseja que faça.

 

obs.: Não consegui baixar sua planilha, meu antivirus detectou um vírus no mesmo.

 

Esse código 

Set xRg = Range("A12:AA12").FindNext(xRg)

 

[isabela queiroz]

@Scofieldgyn não estou sabendo montar o codigo baseado no que voce me passou, deixei aassim 

Sub EnderecoColCabeçalho()

Windows("NXH - 2.4.1.20.0470.xlsx").Activate
    Sheets("NXH - 2.4.1.20.0470").Select

'Macro pra copiar uma coluna pelo nome do cabeçalho
    Dim xRg As Range
    Dim xRgUni As Range
    Dim xFirstAddress As String
    Dim xStr As String
    On Error Resume Next
    xStr = "level" 'Coloque o nome do cabeçalho da coluna que deseja copiar
    Set xRg = Range("A1:D1").Find(xStr, , xlValues, xlWhole, , , True)
    If Not xRg Is Nothing Then
        xFirstAddress = xRg.Address
        Do
            Set xRg = Range("A12:AA12").FindNext(xRg)
            If xRgUni Is Nothing Then
                Set xRgUni = xRg
            Else
                Set xRgUni = Application.Union(xRgUni, xRg)
            End If
        Loop While (Not xRg Is Nothing) And (xRg.Address <> xFirstAddress)
    End If
    xRgUni.EntireColumn.Copy
    
    
Windows("MACRO MAURO.xlsm").Activate
    Sheets("INDO").Select
        Cells.Find(What:="level", After:=ActiveCell, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(1, 0).Range("A1").Select
            ActiveSheet.Paste
    
    
    
End Sub

 

mas não esta copiando nada e ta colando o que ja ta no meu ctrl c 

[Scofieldgyn]

@isabela queiroz

 

coloque Special após o Paste

 

 ActiveSheet.PasteSpecial

[isabela queiroz]

@Scofieldgyn o codigo continua estranho, ta colando o proprio codigo na celula 

ele basicamente continua colando o que ta no meu ctrl c em vez do que ta na planilha e pelo o que entendi seu codigo não faz copiar varias colunas de uma vez, como eu faria pra ser varias juntas adjacentes

[Scofieldgyn]

@isabela queiroz Realmente o código só faz a cópia de uma coluna, nesse caso você conseguir duplicando as variáveis e depois os comandos da rotina.

 

Meu conhecimento está limitado a isso, quem sabe algum colega do fórum tem ideias melhores.

 

1 hora atrás, isabela queiroz disse:

@Scofieldgyn o codigo continua estranho, ta colando o proprio codigo na celula 

ele basicamente continua colando o que ta no meu ctrl c em vez do que ta na planilha e pelo o que entendi seu codigo não faz copiar varias colunas de uma vez, como eu faria pra ser varias juntas adjacentes

 

[OreiaG]

9 horas atrás, isabela queiroz disse:

 ... precisava que, por exemplo, as colunas "tipo, marca, genero e quantidade" fossem colados no "sheet1" de outo excel, ex. "EXEMPLO2.xlsx"

 

Veja se ajuda.

 

Sub CopiaColaColunas()
 Dim UL As Long
  UL = Cells(Rows.Count, 1).End(xlUp).Row
  Range("A12:A" & UL & ",D12:D" & UL & ", E12:E" & UL & ",I12:I" & UL).Copy
  Workbooks("Exemplo2.xlsx").Sheets("Sheet1").[A1].PasteSpecial Paste:=xlPasteValues
End Sub

 

[Márcio Rodrigues]

Olá isabela queiroz

Tentando colaborar, veja se é por aí!!!

Exemplos.rar

[Edson Luiz Branco]

Mais uma opção:

 

Sub CopiaIntercalados()
  Dim rTbl As Range, rTot As Range, rTmp As Range, nomes As Variant, nome As Variant
  nomes = Array("tipo", "marca", "genero", "quantidade")
  Set rTbl = Workbooks("EXEMPLO.xlsx").Worksheets("Sheet1").[A12].CurrentRegion
  For Each nome In nomes
    Set rTmp = Intersect(rTbl, rTbl.Rows(1).Find(What:=nome, LookAt:=xlWhole).EntireColumn)
    If rTot Is Nothing Then Set rTot = rTmp Else Set rTot = Union(rTot, rTmp)
  Next nome
  rTot.Copy Destination:=Workbooks("EXEMPLO2.xlsx").Worksheets("Sheet1").[A12]
  Application.CutCopyMode = False
End Sub

 

[isabela queiroz]

@Scofieldgyn muito obrigada da mesma forma! ajudou muito já!

@Edson Luiz Branco Uma duvida, talvez o que eu quero seja um pouco difícil ou nem seja possível, mas teria como em vez de colocar o nome do workbook pra procurar as colunas, colocar o que esta no meu "copiar"? 

 

ou fazer uma caixa de texto que abre e eu coloco qual workbook preciso abrir? porque vou ter que fazer isso com varios excel e cada um tme um nome diferente e para não ter que reescrever o codigo sempre que precisar, seria melhor que tivesse como substituir o nome do workbook pela caixa de texto ou pelo copiar

 

 

porque antes de eu copiar essas colunas eu preciso abrir um arquivo com o nome de um produto, então se o nome do produto é "NXK - 2.0.1" eu preciso que abra o workbook dele e copie essas colunas da tabela dele

 

vi esse codigo aqui e tentei adaptar mas não funcionou porque não tenho muito conhecimento sobre VBA mas parecia estar no caminho certo 

Sub copParNum()

'essa primeir sub é pra copiar o nome do produto (part number) que preciso achar nos arquivos


Windows("TABELAFINAL.xlsm").Activate
    Sheets("INDO").Select
    
        Cells.Find(What:="part number", After:=ActiveCell, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(1, 0).Range("A1").Select
        Selection.Copy
    
'------colando na frente pra pesquisar na parta
    ActiveCell.Offset(0, 2).Range("A1").Select
       ActiveSheet.PasteSpecial
       
End Sub





Private Sub abrindoProd()

Windows("TABELAFINAL.xlsm").Activate
    Sheets("INDO").Select
    
    
    Cells.Find(What:="pesquisa", After:=ActiveCell, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(1, 0).Range("A1").Select
        Selection.Activate
        
Dim PartN As String
Dim msg

    PartN = Selection.Activate 'aqui eu tentei fazer o codigo pegar o que tava no meu ctrl c e usar para pesquisar nos arquivos o arquivo ocm esse nome, mas não funcionou kkkkk
    

msg = "C:\Users\" & VBA.Environ$("USERNAME") & "\Box\Full Tracker\Macro Desenvolvimento\Fileiras\Fileiras\" & PartN & VBA.vbCr
 Workbooks.Open ("C:\Users\" & VBA.Environ$("USERNAME") & "\Box\Full Tracker\Macro Desenvolvimento\Fileiras\Fileiras\" & PartN)


End Sub

 

quando executo aparece isso aqui 

queria saber como transoformar esse true no que copiei ou no que ta na celula selecionada

[Midori]

@isabela queiroz Você pode criar uma Sub com os parâmetros do destino, origem e nomes dos campos. Assim quando tiver que copiar para outro arquivo é só passar o range como argumento, p.ex,

 

Sub CopiaColunas(Campos As Range, RefDestino As Range, Nomes As Variant)
    Dim Campo   As Range
    Dim Coluna  As Range
    
    For Each Campo In Campos
        If UBound(Filter(Nomes, Campo.Value)) > -1 Then
            Set Coluna = Campo.CurrentRegion.Columns( _
                Campo.Column - Campos(1).Column + 1)            
            Call Coluna.Copy(RefDestino)
            Set RefDestino = RefDestino(1, 2)
        End If
    Next Campo
End Sub

Sub Macro()
    Call CopiaColunas( _
        ThisWorkbook.Sheets("Sheet1").[A12:I12], _
        ThisWorkbook.Sheets("Sheet2").[A1], _
        Array("tipo", "marca", "genero", "quantidade"))
End Sub

 

Se fosse para outro arquivo é só passar para RefDestino, p.ex,

Sub Macro()
    Call CopiaColunas( _
        ThisWorkbook.Sheets("Sheet1").[A12:I12], _
        Workbooks("Teste.xlsx").Sheets("Sheet1").[A1], _
        Array("tipo", "marca", "genero", "quantidade"))
End Sub

 

[isabela queiroz]

@Midori obrigada midori! parece que funcionou aqui, mas sobre a parte de abrir cada excel de cada produto, voce sabe como me ajudar a fazer aquele codigo funcionar para abrir um arquivo baaseado no texto de alguma celula em especifico ou em alguma caixa de texto? 

[Midori]

@isabela queiroz Há várias formas de abrir o arquivo. Pode ser automaticamente com a macro procurando todos os arquivos em algum diretório. Outra forma é com uma caixa de diálogo como GetOpenFilename, padrão Windows de Arquivo > Abrir.

 

O arquivo que será aberto é o que tem a tabela que deve ser copiada? E a tabela dos arquivos começam sempre no mesmo range, como na sua planilha exemplo A12:I12? Se sim, fica mais fácil. Caso contrário será preciso informar o range das colunas de cada arquivo no momento da abertura, manualmente ou automaticamente caso seja possível identificar um padrão.

[isabela queiroz]

@Midori Então, o problema é que depende de que maneira o cliente envia, mas aqui tem um exemplo, ele manda um arquivo e eu fiz uma macro que copia todos "part numbers" que preciso encontrar na tabela, começando por esse "NXH - 2.4.1.20.0470", coloquei uma celula ao lado que copia 1 por 1 ate terminar o codigo ai copia o de baixo, pra ficar maias fácil, ai pensei em fazer uma macro que visse o que tem nessa celula ali embaixo de "pesquisa" e procurasse dentro da pasta do box. 

 

ex. sempre vai estar dentro dessas pastas grifadas, o que muda é o ultimo nome do arquivo que vai ser aberto correspondentemente ao "part number" em questão 

 

"C:\Users\" & VBA.Environ$("USERNAME") & "\Box\Full Tracker\Macro Desenvolvimento\Fileiras\Fileiras\" & "PART NUMBER" 

 

o grifado em vermelho é onde precisa ser alterado conforme o par number.

 

acho que expliquei meio mal, perdão..

[Midori]

@isabela queiroz Se o caminho é sempre o mesmo e só muda a variável "part number", você pode fazer algo assim,

 

Sub Macro()
    Dim Planilha    As Workbook
    Dim PartN       As String
        
    Set Planilha = Workbooks.Open( _
        "C:\Users\" & VBA.Environ$("USERNAME") & _
        "\Box\Full Tracker\Macro Desenvolvimento\Fileiras\Fileiras\" & PartN)

    Call CopiaColunas( _
        ThisWorkbook.Sheets("Sheet1").[A12:I12], _
        Planilha.Sheets("Sheet1").[A1], _
        Array("tipo", "marca", "genero", "quantidade"))
End Sub

 

Para testar é só atribuir o valor para a variável PartN que será o nome do arquivo com a extensão. A macro espera que o nome da planilha com a tabela seja Sheet1.

[isabela queiroz]

@Midori O problema ta sendo é que cada caso tem um numero de part number diferente então eu preciso que o nome do PartN seja baseado ao que esta abaixo de pesquisa, por exemplo, pra sempre que eu alterar ali, eu não precisar alterar no codigo, pode ser por caixa de texto tambem ou qualquer outra forma que eu não conheço ainda, não sei como atribuir o PartN como algo que não seja o proprio texto, como uma celula, por exemplo.

[Midori]

@isabela queiroz Pode ser com inputbux, p.ex,

 

Sub Macro()
    Dim Planilha    As Workbook
    Dim PartN       As String
     
    PartN = InputBox("Part Number")
    
    If PartN <> "" Then
        Set Planilha = Workbooks.Open( _
            "C:\Users\" & VBA.Environ$("USERNAME") & _
            "\Box\Full Tracker\Macro Desenvolvimento\Fileiras\Fileiras\" & PartN)

        Call CopiaColunas( _
            ThisWorkbook.Sheets("Sheet1").[A12:I12], _
            Planilha.Sheets("Sheet1").[A1], _
            Array("tipo", "marca", "genero", "quantidade"))
    End If
End Sub

 

Se quiser pegar de uma célula é só alterar a atribuição,

PartN = [A1]

 

[isabela queiroz]

@Midori Puts agora sim deu certo, muito obrigada to a um tempinho tentando fazer isso funcionar.. Obrigada!!