none
Limitando a quantidande de colunas na macro de consolidação. RRS feed

  • Pergunta

  • Tenho essa instrução de comando abaixo para copiar células, porém quero limitar a quantidade de colunas que serão copiadas (excluindo da cópia) ou fixando o intervalo de colunas sendo que a quantidade de linhas se manterá dinamica.

    Também seria interessante inserir no final de cada linha copiada (na próxima coluna livre) inserir o nome do arquivo de origem (se possível selecionado os caracteres especificos).

    [A3].CurrentRegion.Copy ThisWorkbook.ActiveSheet.Cells(Cells.Rows.Count, "A").End(xlUp).Offset(1, 0)

    • Editado Tomadon quinta-feira, 19 de setembro de 2013 18:34 Altereção do título para melhor indexação.
    quinta-feira, 19 de setembro de 2013 15:00

Respostas

  • Conseguiu resolver o problema das colunas mesclando 2 códigos, rodou sem problemas, a única funsção que faltou agregar foi a de trazer o nome do arquivo (ou caracteres especificos ou também retirando a extenção).

    Sub Consolidar_2()
        Dim Pasta As String
        Dim Arquivo As String
        Dim r As Long, rTemp As Long
        Dim shPadrao As Worksheet
        
        'Seleciona a pasta do Windows onde estão todas as
        'pastas de trabalho a serem copiadas
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Show
            Pasta = .SelectedItems(1)
        End With
        
        'Armazena o nome do primeiro arquivo (pasta de trabalho) na variável "Arquivo"
        Arquivo = Dir(Pasta & "\" & "*.xls*")
        
        Set shPadrao = Sheets("Plan1")
            
        'Laço para para percorrer todos os arquivos da pasta do windows
        Do
            
            'Abre o arquivo
            Workbooks.Open (Pasta & "\" & Arquivo)
            
           'Acha a ultima linha utilizada na planilha onde serao colados os dados
            r = shPadrao.Cells(Rows.Count, "A").End(xlUp).Row
            'Descubro sua quantas linhas ele possui
            rTemp = ActiveWorkbook.ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
            'Colo na planilha principal
            ActiveWorkbook.ActiveSheet.Range("A2:L" & rTemp).Copy shPadrao.Range("A" & r + 1)
    
            
            'Fecha o arquivo
            Workbooks(Arquivo).Close False
                    
            'Lista o próximo arquivo
            Arquivo = Dir
        Loop While Arquivo <> ""
        
        Application.CutCopyMode = False
        
        MsgBox "Fim de Execução da Macro"
        
    End Sub
    
    
    

    • Marcado como Resposta Tomadon quinta-feira, 19 de setembro de 2013 18:32
    quinta-feira, 19 de setembro de 2013 18:32