Copiando uma Aba para outra Planilha - Copy from one workbook and paste into another

Imagine que tenha diversas planilhas, arquivos texto e acesso a algumas views e queries cujos conteúdos precisem regularmente ser usados em um único Dashboard, Book, ou Relatório onde todas as informações são reunidas e apresentadas.

Essa situação lhe parece familiar?

Agora imagine que dentre estes, 15 ou 20 sejam planilhas distintas, das quais precise abrir, copiar e colar os conteúdos, trazendo tudo para uma única planilha, que precisará ser formatada e distribuida.

E se pudesse apenas abrir e copiar as abas que importam, em todas as 20 planilhas, exportando-as para uma única planilha?

Pois bem, isso é possível e acessível. Segue:

Function ExportSheetOutWorkBook(PathName As String, FileName As String, TabTarget As String, TabSource As String)
    ' THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT
    ' LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
    ' Feel free to use the code as you wish but kindly keep this header section intact.
    ' Copyright© A&A - In Any Place®, all Rights Reserved.
    '      Author: André Bernardes
    '     Contact: andreluizbernardess@gmail.com | https://goo.gl/EUMbSe/
    ' Description: Exporta a Sheet informada para uma planilha externa.

    Dim ControlFile As String

    'Call SetMess(True, "Início da movimentação da aba " & TabSource)

    Let ControlFile = ActiveWorkbook.Name

    ' Abre o nome do arquivo.
    Workbooks.Open FileName:=PathName & FileName

    Call SetMess(True, "Início da movimentação da aba (" & TabSource & ") para planilha externa (" & PathName & FileName & ").")

    ' Vai para a aba Source.
    Windows(ControlFile).Activate
    Sheets(TabSource).Select

    ' Copia os dados.
    Sheets(TabSource).Copy After:=Workbooks(FileName).Sheets(1)

    'Call SetMess(True, "Colando dados na planilha externa (" & TabTarget & ") da planilha atual.")

    ' Ative a planilha Target.
    Windows(FileName).Activate

    ActiveWorkbook.Close SaveChanges:=True

    Call SetMess(True, "Salvando na planilha.")

    Windows(ControlFile).Activate
    
    Sheets("Automation").Select

    'Call SetMess(True, "Término da movimentação da aba " & TabTarget)

End Function

Copiar uma planilha específica na pasta ativa

Sub Copier1()
    'Replace "Sheet1" with the name of the sheet to be copied.
    ActiveWorkbook.Sheets("Sheet1").Copy _
       after:=ActiveWorkbook.Sheets("Sheet1")
End Sub

Copiar uma planilha específica na pasta ativa várias vezes

Sub Copier2()
    Dim x As Integer
    
    x = InputBox("Enter number of times to copy Sheet1")
    For numtimes = 1 To x
        'Loop by using x as the index number to make x number copies.
        'Replace "Sheet1" with the name of the sheet to be copied.
        ActiveWorkbook.Sheets("Sheet1").Copy _
           After:=ActiveWorkbook.Sheets("Sheet1")
    Next
End Sub

Copia a Planilha ativa várias vezes

Sub Copier3()
   Dim x As Integer
   
   x = InputBox("Enter number of times to copy active sheet")
   For numtimes = 1 To x
      'Loop by using x as the index number to make x number copies.
      ActiveWorkbook.ActiveSheet.Copy _
         Before:=ActiveWorkbook.Sheets("Sheet1")
         'Put copies in front of Sheet1.
         'Replace "Sheet1" with sheet name that you want.
   Next
End Sub

Copiar todas as planilhas em uma pasta de trabalho uma vez

Sub Copier4()
   Dim x As Integer

   For x = 1 To ActiveWorkbook.Sheets.Count
      'Loop through each of the sheets in the workbook
      'by using x as the sheet index number.
      ActiveWorkbook.Sheets(x).Copy _
         After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
         'Puts all copies after the last existing sheet.
   Next
End Sub

Código de exemplo para mover planilhas

Mover a planilha ativa para uma nova posição na pasta de trabalho

Sub Mover1()
    ActiveSheet.Move _
       After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
       'Moves active sheet to end of active workbook.
End Sub

Mover a planilha ativa para outra pasta de trabalho

Sub Mover2()
    ActiveSheet.Move Before:=Workbooks("Test.xls").Sheets(1)
    'Moves active sheet to beginning of named workbook.
    'Replace Test.xls with the full name of the target workbook you want.
End Sub

Mover Várias Planilhas da Pasta Ativa para Outra Pasta de Trabalho

Sub Mover3()
   Dim BkName As String
   Dim NumSht As Integer
   Dim BegSht As Integer

   'Starts with second sheet - replace with index number of starting sheet.
   BegSht = 2
   'Moves two sheets - replace with number of sheets to move.
   NumSht = 2
   BkName = ActiveWorkbook.Name
    
    For x = 1 To NumSht
      'Moves second sheet in source to front of designated workbook.
      Workbooks(BkName).Sheets(BegSht).Move _
         Before:=Workbooks("Test.xls").Sheets(1)
         'In each loop, the next sheet in line becomes indexed as number 2.
      'Replace Test.xls with the full name of the target workbook you want.
    Next
End Sub

⬛◼◾▪ Social Media ▪◾◼⬛

• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 

• VBA Specialist® • VBA Excel Specialist®

• VBA Access Specialist® • VBA Dashboards Specialist®

• VBA Infografics Specialist® • VBA Pharma Specialist® 

⬛◼◾▪ CONTATO ▪◾◼⬛

brazilsalesforceeffectiveness@gmail.com

VBA - Renomeando arquivos aleatóriamente numa pasta - Renaming files Randomly in a folder using VBA

| Blog Office VBA | Blog Excel | Blog Access | Blog Infochart | 

Você tem direito as informações da sua empresa

MIS - Usufruindo a excelência na análise das suas Informações

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Key Performance Indicators - 7 Características desejáveis

Tópicos relacionados:

Business English - Termos em inglês do mundo dos negócios - Speaking the lingo

Acrônimos - Technology, Electronics and Games Acronyms

13 Dicas para se Falar em Público

Os 10 mandamentos do gerenciamento de projetos

KPI - Key Performance Indicator

Acesse: http://goo.gl/0v6AO   

Sim, agora poderemos dar nomes aleatórios há vários arquivos reunidos numa pasta. Todos serão renomeados:

Function ReFileNameRandomly (Prefix As String, _

                    FILEPATH As String, _

                    nExtension As String, _

                    FinalExtension As String)

    

    Dim strfile As String

    Dim filenum As String

    Dim SizeExtension As Integer

    Dim sFileNumber As String

    

    Let strfile = Dir(FILEPATH)

    Let SizeExtension = Len(Replace(nExtension, ".", ""))

    Do While strfile <> ""

        Debug.Print strfile

    

        If Right$(strfile, SizeExtension) = nExtension Then

            Let filenum = Mid$(strfile, Len(strfile) - 6, SizeExtension)

            Let sFileNumber = Int((99999 - 10000 + 1) * Rnd + 10000)

            

            Name FILEPATH & strfile As FILEPATH & Prefix & sFileNumber & "." & FinalExtension

        End If

        Let strfile = Dir

    Loop

End Function

Tags: VBA, file, rename, folder, pasta, tips, randomly, aleatoriamente, aleatório, renomear

VBA Tips - Renomeando TODOS arquivos numa pasta - Renaming all files in a folder

| Blog Office VBA | Blog Excel | Blog Access | Blog Infochart | 

Você tem direito as informações da sua empresa

MIS - Usufruindo a excelência na análise das suas Informações

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Key Performance Indicators - 7 Características desejáveis

Tópicos relacionados:

Business English - Termos em inglês do mundo dos negócios - Speaking the lingo

Acrônimos - Technology, Electronics and Games Acronyms

13 Dicas para se Falar em Público

Os 10 mandamentos do gerenciamento de projetos

KPI - Key Performance Indicator

Acesse: http://goo.gl/0v6AO   

Ao descarregar umas 700 fotos de uma câmera, também precisei renomeá-las. Pode imaginar como seria rápido fazer isso? 

Percebi que alterá-las manualmente, não era algo que estava interessado em fazer, então eu debrucei-me sob o VBA para resolver-me este "problema".

Este código percorrerá uma pasta e renomeará todos os arquivos nela.

Function ReFileName (Prefix As String, _

                    FILEPATH As String, _

                    nExtension As String, _

                    FinalExtension As String)

    

    Dim strfile As String

    Dim filenum As String

    Dim SizeExtension As Integer

    

    Let strfile = Dir(FILEPATH)

    Let SizeExtension = Len(Replace(nExtension, ".", ""))

    Do While strfile <> ""

        Debug.Print strfile

    

        If Right$(strfile, SizeExtension) = nExtension Then

            Let filenum = Mid$(strfile, Len(strfile) - 6, SizeExtension)

    

            Name FILEPATH & strfile As FILEPATH & Prefix & filenum & "." & FinalExtension

        End If

        Let strfile = Dir

    Loop

End Function

Tags: VBA, file, rename, folder, pasta, tips

VBA Excel - Imprimindo planilhas selecionadas ou não.

Olá pessoal!

Nossas planilhas, e neste caso refiro-me as inúmeras 'sheets' ou pastas dentro de uma única planilha (workbook). Com o passar do tempo, se não tomarmos cuidado, acabam sendo compostas por diversas interfaces diferentes. Algumas com visões consolidadas e outras detalhadas (drilldown).

Independentemente de quão amplo sejam os nossos workbooks, invariavelmente precisaremos imprimir o seu conteúdo, geralmente representados por Dashboards & Scorecards, ou Cockpits.

Os três exemplos abaixo visam permitir que possa dar diversas opções de impressão aos seus usuários, e obviamente a você mesmo.

1º EXEMPLO

Este código imprime as todas as planilhas selecionadas, veja o código do procedimento inPrintSelectedsSheets mostrado abaixo.

Sub inPrintSelectedSheets (Preview As Boolean)

Dim N As Long

Dim M As Long

Dim Arr() As String

With ActiveWindow.SelectedSheets

ReDim Arr(1 To .Count)

For N = 1 To .Count

Let Arr(N) = .Item(N).Name

Next N

End With

Sheets(Arr).PrintOut Preview:=True

End Sub

2º EXEMPLO

Já este código a seguir imprime apenas as planilhas não selecionadas através do procedimento inPrintUnSelectedSheets:

Sub inPrintUnselectedSheets (Preview As Boolean)

Dim WS As Object

Dim N As Long

Dim Arr() As String

Dim K As Long

Dim B As Boolean

ReDim Arr(1 To ActiveWorkbook.Sheets.Count)

For Each WS In ActiveWorkbook.Sheets

Let B = True

With ActiveWindow.SelectedSheets

For N = 1 To .Count

Let B = True

If StrComp(WS.Name, .Item(N).Name, vbTextCompare) = 0 Then

Let B = False

Exit For

End If

Next N

If B = True Then

Let K = K + 1

Let Arr(K) = WS.Name

End If

End With

Next WS

If K > 0 Then

ReDim Preserve Arr(1 To K)

ActiveWorkbook.Sheets(Arr).PrintOut Preview:=Preview

End If

End Sub

3º EXEMPLO

O código a seguir exclue as planilhas informadas na seleção, imprimindo todas as demais com o procedimento inPrintSheetsExclude. Use assim: inPrintSheetsExclude false, "Sheet2", "Sheet4", "Sheet6". Perceba que todas as sheets serão impressas, excetuando-se as sheets: Sheet2, Sheet4, e Sheet6, veja o código:

Sub inPrintSheetsExclude (Preview As Boolean, ParamArray Excludes() As Variant)

Dim Arr() As String

Dim B As Boolean

Dim N As Long

Dim M As Long

Dim K As Long

ReDim Arr(1 To Sheets.Count)

For N = 1 To Sheets.Count

Let B = True

For M = LBound(Excludes) To UBound(Excludes)

If StrComp(Sheets(N).Name, Excludes(M), vbTextCompare) = 0 Then

Let B = False

Exit For

End If

Next M

If B = True Then

Let K = K + 1

Let Arr(K) = Sheets(N).Name

End If

Next N

If K > 0 Then

ReDim Preserve Arr(1 To K)

Sheets(Arr).PrintOut Preview:=Preview

End If

End Sub

Fonte: C Person

Tags: André Luiz Bernardes, Microsoft, MOS, MS, Office, Office 2007, Office 2010, automation, automação, print, various print, simultaneously print, multi print,

André Luiz Bernardes

A&A® - Work smart, not hard.

VBA - Deletando Arquivos, Pastas e Diretórios

Delete Files Via Vba

Delete Text File

Delete a folder and all subfolders and files

Delete files in a folder VBA

Deleting a file in VBA

How remove file

How to delete files using VBA

How to use VBA to delete files

I need to copy, rename and delete files in a folder

Macro to delete all files

Move and Delete files and folders

Remove Files

Já tentou apagar um arquivo externo a sua aplicação? Talvez uma planilha ou um arquivo texto?

Pense, como posso excluir um arquivo?

- Olhe para isto: "Poderia basicamente usar o comando Kill, mas um programador preocupado precisa permitir a possibilidade de existir um arquivo que está sendo usado somente como leitura, eis a função para você:

DeleteFile ("Bernardes_Dashboard_Results.txt")

 

Sub DeleteFile (ByVal FileToDelete As String)

 

If FileExists (FileToDelete) Then

 

SetAttr FileToDelete, vbNormal

 

Kill FileToDelete

 

End If

 

End Sub

Não se esqueça da função que checa a existência do arquivo:

Function FileExists(ByVal FileToTest As String) As Boolean

Let FileExists = (Dir(FileToTest) <> "")

End Function

 

Ahhh, você pode definir uma referência para a biblioteca Scripting.Runtime e depois usar o FileSystemObject, este tem dois métodos DeleteFile e FileExists.

Não vou esconder que temos outras opções:

Let nTest = Dir (filename)

 

If not nTest="" then

 

Kill (Filename)

 

end if

O código a seguir pode ser usado para testar a existência de um arquivo, e depois excluí-lo:

Dim aFile As String

 

Let nFile = "c:\Bernardes_Dashboard_Results.txt"

 

If Len (Dir$(nFile)) > 0 Then

 

Kill nFile

 

End If

Estava me segurando, mas preciso avisar-lhe quanto a não permitir que o código retorne uma mensagem de erro do tipo "Desculpe-me, mas não existe nenhum código para apagar", então coloque também algo como o mostrado abaixo:

On Error Resume Next

Kill "

c:\Bernardes_Dashboard_Results.txt

"

 

On Error Goto 0

Return Len(Dir$(aFile)) > 0

As opções não param. Aqui está um método simples de apagar uma pasta e todos os arquivos e subpastas. Ele usa o File System Object (objeto sistema de arquivos).

Para usá-lo, você terá que definir uma referência para o Microsoft Scripting Runtime geralmente encontrada em C:\WINDOWS\system32\scrrun.dll.

Sub DeleteAllFolders(FolderPath As String)

Dim fso As Scripting.FileSystemObject

Set fso = New Scripting.FileSystemObject

On Error Resume Next

fso.DeleteFolder (FolderPath)

Set fso = Nothing

End Sub

 

O método fso.DeleteFolder não pode retirar a barra à direita ("\") do path, por isso precisamos removê-la quando aparecer.

Function CorrectPath(FolderPath As String) As String

 

Let FolderPath = Trim(FolderPath)

 

If Right(FolderPath, 1) = "\" Then

Let CorrectPath = Left(FolderPath, Len(FolderPath) - 1)

Else

Let CorrectPath = FolderPath

End If

 

End Function

 

Compartilhe este artigo!