Views

...

Important:

Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog podem ser tratados como consultoria freelance.

E-mails

Deixe seu e-mail para receber atualizações...

eBook Promo

Mostrando postagens com marcador copiar. Mostrar todas as postagens
Mostrando postagens com marcador copiar. Mostrar todas as postagens

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 ▪◾◼⬛ 

⬛◼◾▪ CONTATO ▪

VBA Excel Basic - Copiando um Range de Planilha para Planilha - Copy a range in an Excel sheet using vba



Sub Copy_Data()
Let Application.ScreenUpdating = False

Let Worksheets("Plan01").Range("B2:Y34").Value = ActiveSheet("Plan02").Range("B2:Y34").Value

Let Application.ScreenUpdating = True
End Sub

Outro modo de fazer a mesma coisa:

Sub Macro1()
  Range("B2:Y34").Select

  Selection.Copy

  Sheets("Sheet5").Select

  Range("B2").Select

  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,    SkipBlanks:=False, Transpose:=False
End Sub

Copiando uma coluna:

Sheets("Temp").Columns(1).Copy

Sheets("Overview").Range("C40").PasteSpecial



Tags: VBA, Excel, Range, Planilha, Copiar, Copy, 


Excel VBA - Copie qualquer objeto como imagem e exporte-o



Lembro-me de há alguns, quando criei este Blog específico de VBA, como ainda era incipiente a inter-colaboração de códigos VBA no mercado nacional, bem como a utilização profissional de Dashboards e Scorecards. O desenvolvimento VBA naquela época restringia-se aos expressão "faz-se macros no excel'. Hoje, estamos vivenciando um mercado de desenvolvimento VBA mais maduro, cheio de profissionais competentíssimos (tomara que essa expressão não seja um neologismo), com inúmeras excelentes soluções de desenvolvimento e aplicações de automação. Encontramo-nos amadurecidos e prontos para avançarmos no nosso ciclo de aprimoramento profissional!

O artigo a seguir visa elevar a qualidade da nossa entrega. Enviar o conteúdo das nossas soluções para outros ambientes e interfaces. Das aplicações da suíte MS Office, a editores gráficos para a criação de Info Gráficos e até mesmo a inserção destes em páginas da Web de modo automático (Sharepoint). Mas prá que quero isso? Talvez pergunte-se. Abaixo seguem diversos códigos bem elaborados que possibilitarão copiar os gráficos das suas planilhas pré-existentes, bem como os ranges de dados destas (conjuntos de células previamente selecionados) como uma imagem. 

Detalho:
Por vezes desejará não enviar a fonte de dados junto com o gráfico para um Slide que lhe solicitaram.

Talvez deseje enviar uma tabela, um relatório, partes de um Balanced Scorecard, um Dashboards ou um  Scorecards, ou mesmo um conjunto deKPIs, sem que estes sejam alterados por quem recebê-los.

Criar um informativo regular, parte de um relatório, que envia via MS Outlook, comentários dos
relatórios, agregando conteúdo analítico e não apenas gráficos e dados estáticos para o público alvo.

Como fazê-lo?
Com os recursos abaixo alistados, poderá enviar somente as imagens, como se tirasse uma foto e colasse no Slide, num documento MS Word, num e-mail e até mesmo no Photoshop (há!).

Chega! Essas são apenas algumas das possibilidades...Pensem em outras...

CÓDIGO: 
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture


Para copiar um gráfico selecionado (ou ativo) em uma planilha, implemente a seguinte sintaxe:

CÓDIGO: 
ActiveChart.CopyPicture Appearance:=xlScreen, Format:=xlPicture


Copiando um range de dados, colando-a como uma imagem:

CÓDIGO: 
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture


Copie gráficos selecionados (ou ativo) em uma planilha, implemente a seguinte sintaxe:

CÓDIGO: 
Worksheets("Nome da pasta").ChartObjects(1).Chart.CopyPictureAppearance:=xlScreen, Size:=xlScreen, Format:=xlPicture


Copie uma faixa de dados específica, embora não esteja selecionada, colando-a a posteriori:



CÓDIGO: 

Worksheets("Nome da pasta").Range("B11:AF25").CopyPicture Appearance:=xlScreen, Format:=xlPicture


Pois é, sempre existem códigos admiráveis por aí:



CÓDIGO:

Sub GraficoToPowerPoint()

    Dim objPPT As Object

    Dim objPrs As Object

    Dim shtTemp As Worksheet

    Dim chtTemp As ChartObject

    Dim intSlide As Integer

     

    Set objPPT = CreateObject("Powerpoint.application")

    objPPT.Visible = True

    objPPT.presentations.Open ThisWorkbook.Path & "\Dashboard_Bernardes.ppt"

    objPPT.ActiveWindow.ViewType = 1 'ppViewSlide

     

    For Each shtTemp In ThisWorkbook.Worksheets

        For Each chtTemp In shtTemp.ChartObjects

            intSlide = intSlide + 1

            chtTemp.CopyPicture

            If intSlide > objPPT.presentations(1).Slides.Count Then

                objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.presentations(1).Slides.Add(Index:=intSlide, Layout:=1).SlideIndex

            End If

            objPPT.ActiveWindow.View.Paste

        Next

    Next

    objPPT.presentations(1).Save

    objPPT.Quit

     

    Set objPrs = Nothing

    Set objPPT = Nothing

End Sub


Copiando range e gráfico para o MS Powerpoint:


CÓDIGO:

Sub GraficoRange_TO_Powerpoint() 

    Dim objPPT As Object 

    Dim objPrs As Object 

    Dim objSld As Object 

    Dim shtTemp As Object 

    Dim chtTemp As ChartObject 

    Dim objShape As Shape 

    Dim objGShape As Shape 

    Dim intSlide As Integer 

    Dim blnCopy As Boolean 

     

    Set objPPT = CreateObject("Powerpoint.application") 

    objPPT.Visible = True 

    objPPT.Presentations.Add 

    objPPT.ActiveWindow.ViewType = 1

     

    For Each shtTemp In ThisWorkbook.Sheets 

        blnCopy = False 

        If shtTemp.Type = xlWorksheet Then 

            For Each objShape In shtTemp.Shapes

                blnCopy = False 

                If objShape.Type = msoGroup Then 



                    For Each objGShape In objShape.GroupItems 

                        If objGShape.Type = msoChart Then 

                            blnCopy = True 

                            Exit For 

                        End If 

                    Next 

                End If 

                If objShape.Type = msoChart Then blnCopy = True 

                 

                If blnCopy Then 

                    intSlide = intSlide + 1 

                    objShape.CopyPicture 



                    objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex 

                    objPPT.ActiveWindow.View.Paste 

                End If 

            Next 

            If Not blnCopy Then 



                intSlide = intSlide + 1 

                shtTemp.UsedRange.CopyPicture 



                objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex 

                objPPT.ActiveWindow.View.Paste 

            End If 

        Else 

            intSlide = intSlide + 1 

            shtTemp.CopyPicture 



            objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex 

            objPPT.ActiveWindow.View.Paste 

        End If 

    Next 

     

    Set objPrs = Nothing 

    Set objPPT = Nothing 

End Sub


Bônus:



CÓDIGO: 

Sub RangeUsado_TO_Powerpoint()

    Dim objPPT As Object

    Dim shtTemp As Object

    Dim intSlide As Integer

     

    Set objPPT = CreateObject("Powerpoint.application")

    objPPT.Visible = True

    objPPT.Presentations.Open ThisWorkbook.Path & "\Bernardes.ppt"

    objPPT.ActiveWindow.ViewType = 1

    

    For Each shtTemp In ThisWorkbook.Sheets

        shtTemp.Range("A1", shtTemp.UsedRange).CopyPicture xlScreen, xlPicture

        intSlide = intSlide + 1



        objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex

        objPPT.ActiveWindow.View.Paste

        With objPPT.ActiveWindow.View.Slide.Shapes(objPPT.ActiveWindow.View.Slide.Shapes.Count)

            .Left = (.Parent.Parent.SlideMaster.Width - .Width) / 2

        End With

    Next

     

    Set objPPT = Nothing

End Sub


Boa diversão!

Tags: VBA, Excel, copy, object, objeto, copiar, chart, gráfico

eBooks VBA na AMAZOM.com.br

LinkWithinBrazilVBAExcelSpecialist

Related Posts Plugin for WordPress, Blogger...

Vitrine