Excel VBA - Copiar

  • - Acesso Livre
  • Documentos

    Ordenar por : Nome | Data | Acessos | [ Ascendente ]

    vba copia dados coluna a separado virgula inputbox relacionando vba copia dados coluna a separado virgula inputbox relacionando

    popular!
    Adicionado em: 20/11/2010
    Modificado em: 20/11/2010
    Tamanho: Vazio
    Downloads: 649

    Saberexcel - o site das macros
    Esses procedimentos do Aplicativo Microsoft Excel VBA, copia os dados da linha selecionada para a coluna(A1), selecionado o e listando os dados desejados. Isso com auxlio de uma entrada de dados (Inputbox)
    Observe que usei a propriedade OffSet para deslocar uma linha abaixo para colar os dados.
    É muito importante aprender sobre esta propriedade para um bom aprendizado em VBA, temos excelentes exemplos nos módulos
    COMO FAZER - Programação MS Excel VBA - Saberexcel.

    Private Sub Worksheet_Activate()
    Application.EditDirectlyInCell = False
    End Sub

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim vCelula As Long
    Dim vEndereco As String

    vCelula = ActiveCell.Row
    vEndereco = Cells(vCelula, 3)
    vEndereco = vEndereco & ", " & Cells(vCelula, 4)
    vEndereco = vEndereco & ", " & Cells(vCelula, 5)
    vEndereco = vEndereco & ", " & Cells(vCelula, 6)
    vEndereco = vEndereco & ", " & Cells(vCelula, 7)

    vEndereco = InputBox("Selecione a linha desejada!", Cells(vCelula, 4) & " - " & Cells(vCelula, 5) & "- [ Saberexcel ] ", vEndereco)
    [A65000].End(xlUp).Offset(1, 0).Select
    'deslocando para primeira célula em branco
    ActiveCell.Value = vEndereco

    End Sub



    Aprenda tudo sobre o aplicativo Microsoft Excel VBA com Saberexcel



    vba copia distribuindo dados produtos nas planilhas vba copia distribuindo dados produtos nas planilhas

    popular!
    Adicionado em: 20/11/2010
    Modificado em: 20/11/2010
    Tamanho: Vazio
    Downloads: 606

    SaberExcel - o Site das Macros
    Essa macro do Aplicativo Microsoft Excel VBA, copia dados desejados de uma planilha principal para outras planilhas indicadas, observe que a macro faz a referencia para exportação de dados na coluna(A), com o prefixo do nome da Planilha, por exemplo PRODUTORES LISTA, ("P"), SB PECAS("S"), TB CODIGO("T")

    Sub Copiando_dados_distribuindo_plans_desejadas()

    Dim vPlanPrincipal, vPlanilhaP, vPlanilhaS, vPlanilhaT As String
    Dim vContinuar As Boolean
    Dim vPrimeiraLinha, vLinha As Integer
    Dim vAtualPLinha, vAtualSLinha, vAtualTLinha As Integer

    'nome referenciando as folhas de planilha
    vPlanPrincipal = "BOM"
    vPlanilhaP = PRODUTORES LISTA"
    vPlanilhaS = "PARTES PECAS"
    vPlanilhaT = "CODIGOS"

    'Inicializando com as variáveis
    vContinuar = True
    vPrimeiraLinha = 13
    vLinha = vPrimeiraLinha
    vAtualPLinha = 12
    vAtualSLinha = 12
    vAtualTLinha = 12

    Sheets(vPlanPrincipal).Select

    'Um loop por todos os valores da coluna(A) até encontrar uma célula em branco
    While vContinuar = True

    'Quando encontrar uma célula em branco, não continua
    If Len(Range("A" & CStr(vLinha)).Value) = 0 Then
    vContinuar = False
    'copiando e formatando dados
    Else

    'inserindo uma borda arredondada nas células
    Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeLeft).Weight = xlThin
    Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeTop).Weight = xlThin
    Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeBottom).Weight = xlThin
    Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlEdgeRight).Weight = xlThin
    Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlInsideVertical).LineStyle = xlContinuous
    Range("A" & CStr(vLinha) & ":I" & CStr(vLinha)).Borders(xlInsideVertical).Weight = xlThin

    'referenciando às células da coluna(I)
    Range("I" & CStr(vLinha)).Formula = "=H" & CStr(vLinha) & "*QTY"

    '--- "A" ---
    If Range("A" & CStr(vLinha)).Value = "A" Then

    'Negrito e justificando à esquerda
    Range(CStr(vLinha) & ":" & CStr(vLinha)).Font.Bold = True
    Range(CStr(vLinha) & ":" & CStr(vLinha)).HorizontalAlignment = xlLeft

    'se nao encontrar a primeira linha, insere uma linha em branco
    If vLinha <> vPrimeiraLinha Then
    Rows(CStr(vLinha) & ":" & CStr(vLinha)).Select
    Selection.Insert Shift:=xlDown
    vLinha = vLinha + 1
    End If

    '--- "P" ---
    ElseIf Range("A" & CStr(vLinha)).Value = "P" Then

    'Cópia dados avaliando das colunas B, C, F, G, para folha BMO
    Range("B" & CStr(vLinha) & ",C" & CStr(vLinha) & ",F" & CStr(vLinha) & ",G" & CStr(vLinha) & ",I" & CStr(vLinha)).Select
    Selection.Copy

    'Para folha "LISTA COMPRADORES"
    Sheets(vPlanilhaP).Select
    Range("A" & CStr(vAtualPLinha)).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("A1").Select

    'adicionando bordas arredondadas nas células
    Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeLeft).Weight = xlThin
    Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeTop).Weight = xlThin
    Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeBottom).Weight = xlThin
    Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlEdgeRight).Weight = xlThin
    Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlInsideVertical).LineStyle = xlContinuous
    Range("A" & CStr(vAtualPLinha) & ":E" & CStr(vAtualPLinha)).Borders(xlInsideVertical).Weight = xlThin

    'incrementando linha contador na planilha "LISTA COMPRADORES"
    vAtualPLinha = vAtualPLinha + 1

    'Retornando a planilha BOM no local de origem
    Sheets(vPlanPrincipal).Select

    '--- "S" ---
    ElseIf Range("A" & CStr(vLinha)).Value = "S" Then

    'copia avaliando as colunas B, C, e E da folha BMO
    Range("B" & CStr(vLinha) & ",C" & CStr(vLinha) & ",E" & CStr(vLinha)).Select
    Selection.Copy

    'Cola os dados na planilha "PARTES PECAS"
    Sheets(vPlanilhaS).Select
    Range("A" & CStr(vAtualSLinha)).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'copie valores das colunas D, F, G, e da folha BMO
    Sheets(vPlanPrincipal).Select
    Range("D" & CStr(vLinha) & ",F" & CStr(vLinha) & ",G" & CStr(vLinha) & ",I" & CStr(vLinha)).Select
    Selection.Copy

    'cola dados na planilha "PARTES PECAS"
    Sheets(vPlanilhaS).Select
    Range("D" & CStr(vAtualSLinha)).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("A1").Select

    'Insere bordas arredondadas nas células
    Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeLeft).Weight = xlThin
    Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeTop).Weight = xlThin
    Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeBottom).Weight = xlThin
    Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlEdgeRight).Weight = xlThin
    Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlInsideVertical).LineStyle = xlContinuous
    Range("A" & CStr(vAtualSLinha) & ":G" & CStr(vAtualSLinha)).Borders(xlInsideVertical).Weight = xlThin

    'incrementa o contador de linhas na planilha "PARTES PECAS"
    vAtualSLinha = vAtualSLinha + 1

    'Retorna para planilha BMO e continua onde parou
    Sheets(vPlanPrincipal).Select

    '--- "T" ---
    ElseIf Range("A" & CStr(vLinha)).Value = "T" Then

    'copia valores da coluna B para planilha BMO
    Range("B" & CStr(vLinha)).Select
    Selection.Copy

    'Cola os dados na planilha "CODIGOS"
    Sheets(vPlanilhaT).Select
    Range("A" & CStr(vAtualTLinha)).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    'insere vírgula nos lugares na coluna(B)
    Range("B" & CStr(vAtualTLinha)).Value = ","

    'Copia os valores de coluna(I) da planilha BMO)
    Sheets(vPlanPrincipal).Select
    Range("I" & CStr(vLinha)).Select
    Selection.Copy

    'Cola os valores na planilha "CODIGOS"
    Sheets(vPlanilhaT).Select
    Range("C" & CStr(vAtualTLinha)).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("A1").Select

    'insere bordas arredondadas nas células
    Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeLeft).Weight = xlThin
    Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeTop).Weight = xlThin
    Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeBottom).Weight = xlThin
    Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlEdgeRight).Weight = xlThin
    Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlInsideVertical).LineStyle = xlContinuous
    Range("A" & CStr(vAtualTLinha) & ":C" & CStr(vAtualTLinha)).Borders(xlInsideVertical).Weight = xlThin

    'incrementa o contador da planilha "CODIGOS"
    vAtualTLinha = vAtualTLinha + 1

    'Retorna para a planilha BMO
    Sheets(vPlanPrincipal).Select

    End If

    End If

    vLinha = vLinha + 1

    Wend

    MsgBox "Os dados foram copiados com sucesso!!", vbInformation, "Saberexcel - site das macros"

    End Sub



    Aprenda Aplicativo Microsoft Excel VBA --(( Saberexcel ))--



    Página 3 de 3

    PROMOÇÃO DIDÁTICOS SABEREXCEL



    Adquira já o Acesso Imediato
    à Area de Membros

    Compra Grantida --- Entrega Imediata

    Aprenda Excel VBA com Simplicidade de 
    códigos e Eficácia, Escrevendo Menos e
    Fazendo Mais.

    '-------------------------------------'
    Entrega Imediata:
    +  500 Video Aulas MS Excel VBA
    +  35.000 Planilhas Excel e VBA
    +  Coleção 25.000 Macros MS Excel VBA
    +  141 Planilhas Instruções Loops
    +  341 Planilhas WorksheetFunctions(VBA)
    +    04 Módulos Como Fazer Excel VBA
    +  Curso Completo MS Excel VBA
    +  Planilhas Inteligentes


    Pesquisa Google SaberExcel

    Publicidade Google

    <script type="text/javascript"><!--

    google_ad_client = "ca-pub-2317234650173689";

    /* retangulo 336 x 280 */

    google_ad_slot = "0315083363";

    google_ad_width = 336;

    google_ad_height = 280;

    //-->

    </script>

    <script type="text/javascript"

    src="http://pagead2.googlesyndication.com/pagead/show_ads.js">

    </script>

    Publicidade

    RSFirewallProtected


    Google Associados

    Depoimentos

    Adicione Saberexcel Favoritos

     
     

    Aprenda tudo sobre o Aplicativo Microsoft Excel VBA

    Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel,


       Sobre as WorksheetFunctions Funções de Planilhas que retornam valores do VBA