Guru do Excel e Power BI

Fórum de Dúvidas sobre Excel e Power BI
https://gurudoexcel.com/

Copia 1 linha, pula 1 e a cada grupo de 7 pula 2 linhas loop

https://gurudoexcel.com/viewtopic.php?t=12265

Página 1 de 1

Copia 1 linha, pula 1 e a cada grupo de 7 pula 2 linhas loop

Enviado: 23 Mai 2020 às 14:24
por Alexmanza
Prezados, tenho uma planilha que serve de base haba digitar, e a txt. Estou com dificuldades em combinar comandos do vba para copiar as linhas intercaladas de uma em uma e a cada sequencia de 7 itens pula 2 linhas em branco. A planilha txt uso a base dados para copiar em uma tela que aceita no máximo 7 itens. e toda vez que surge pessoas novas lançadas na primeira haba "digitar" eu acabo lançando manualmente na "txt", gostaria de automatizar a tarefa mais estou com dificuldades em encontrar a mescla de comandos. Já consegui uma parte que configura a formatação das linhas e colunas, mas não estou conseguindo copiar nesse mesmo formato.Obs na coluna de valor tenho que multiplicar por 100, pois meu sistema não aceita vírgula na digitação.
Código: Selecionar todos
Sub teste ()
    Dim yVar1 As Long
    Dim yVar2 As Long
    yVar1 = 8
    Do While 1 = 1
        For yVar2 = 1 To 7
            Range(Cells(yVar1, 2), Cells(yVar1, 2)).Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Selection.RowHeight = 3
            yVar1 = yVar1 + 2
        Next yVar2
        'For yVar2 = 1 To 2
        '    Rows(yVar1, 2).Select
        '    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        '    Selection.RowHeight = 3
        'Next yVar2
        yVar1 = yVar1 + 2
        If yVar1 > 200 Then Exit Do
        
    Loop
    Columns("C:G").Select
    Selection.ColumnWidth = 0.5
    Columns("K:Q").Select
    Selection.ColumnWidth = 0.5
    MsgBox "acabei"


End Sub

Re: Copia 1 linha, pula 1 e a cada grupo de 7 pula 2 linhas

Enviado: 23 Mai 2020 às 18:07
por babdallas
Não entendi muito bem. Tente dar mais detalhes do que significa o txt e qual o resultado esperado na outra planilha.
A macro precisa copiar tudo do txt para a outra planilha sem os espações?

Re: Copia 1 linha, pula 1 e a cada grupo de 7 pula 2 linhas

Enviado: 23 Mai 2020 às 18:26
por Alexmanza
a matriz é a primeira planilha a txt busca da primeira planilha para transformar os dados no formato que preciso para colar de 7 em 7 posteriormene em uma tela do sistema financeiro que eu trabalho. Uma pessoa escreveu a primeira etapa da formula na primeira postagem que é somente a formatação, ficou para eu desenvolver como eu copiaria os dados de 7 em 7 pulando linha (esse pular linhar seria somente para a pessoa que for selecionar/copiar/colar) no sistema não se perder. Resumindo queria copiar na planilha txt as informações da primeira planilha com o padrão que está nela ou seja primeira sequencia de colunas de 0,50 segunda sequencia 8 colunas 0,50, linhas 3,0. bom eu gravei uma macro, gostaria que ela automatizasse buscando as informações somente das células que forem preenchidas na planilha matriz, segue o código:
Código: Selecionar todos
Sub copiar2tudo()
'
' copiar2tudo Macro
'
' Atalho do teclado: Ctrl+e
'
    Sheets.Add After:=ActiveSheet
    ActiveCell.FormulaR1C1 = "=digitar!R[6]C[3]"
    Range("A1").Select
    Sheets("digitar").Select
    ActiveWindow.Zoom = 106
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    Sheets("Planilha1").Select
    Selection.AutoFill Destination:=Range("A1:F1"), Type:=xlFillDefault
    Range("A1:F1").Select
    Selection.AutoFill Destination:=Range("A1:I1"), Type:=xlFillDefault
    Range("A1:I1").Select
    Selection.AutoFill Destination:=Range("A1:K1"), Type:=xlFillDefault
    Range("A1:K1").Select
    Selection.AutoFill Destination:=Range("A1:K121"), Type:=xlFillDefault
    Range("A1:K121").Select
    ActiveWindow.LargeScroll Down:=-6
    Columns("E:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("A:A").Select
    Selection.NumberFormat = "00000000000"
    Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Columns("B:B").Select
    Range("B100").Activate
    Selection.NumberFormat = "000"
    Columns("C:C").Select
    Range("C100").Activate
    Selection.NumberFormat = "0000"
    Columns("D:D").Select
    Range("D100").Activate
    Selection.NumberFormat = "0000000000"
    Columns("E:E").Select
    Range("E100").Activate
    Selection.NumberFormat = "00000000000000000"
    Range("E1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = "=digitar!R[6]C[9]*100"
    Range("B6").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C14").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C2").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C13").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C1").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Range("K13").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Range("K2").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Range("K13").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Range("K1").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Range("K11").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Range("L13").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Range("L4").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Range("L9").Select
    Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveWindow.Zoom = 98
    ActiveWindow.Zoom = 96
    ActiveWindow.Zoom = 95
    ActiveWindow.Zoom = 93
    ActiveWindow.Zoom = 91
    ActiveWindow.Zoom = 89
    ActiveWindow.Zoom = 87
    ActiveWindow.Zoom = 86
    ActiveWindow.Zoom = 84
    Range("B:B,C:C,D:D,E:E,F:F,G:G,K:K,L:L,M:M,N:N,O:O,P:P,Q:Q,R:R").Select
    Range("R1").Activate
    Selection.ColumnWidth = 0.5
    ActiveWindow.Zoom = 86
    ActiveWindow.Zoom = 87
    ActiveWindow.Zoom = 89
    ActiveWindow.Zoom = 100
    Range("A8").Select
    Selection.EntireRow.Insert
    Range("A16").Select
    Selection.EntireRow.Insert
    Range("A17:A23").Select
    ActiveWindow.SmallScroll Down:=8
    Range("A24").Select
    Selection.EntireRow.Insert
    Range("A32").Select
    Selection.EntireRow.Insert
    ActiveWindow.SmallScroll Down:=19
    Range("A40").Select
    Selection.EntireRow.Insert
    Range("A48").Select
    Selection.EntireRow.Insert
    Range("A49:A55").Select
    ActiveWindow.SmallScroll Down:=7
    Range("A56").Select
    Selection.EntireRow.Insert
    Range("A64").Select
    Selection.EntireRow.Insert
    ActiveWindow.SmallScroll Down:=4
    Range("A72").Select
    Selection.EntireRow.Insert
    Range("A80").Select
    Selection.EntireRow.Insert
    Range("A88").Select
    Selection.EntireRow.Insert
    ActiveWindow.SmallScroll Down:=16
    Range("A96").Select
    Selection.EntireRow.Insert
    Range("A104").Select
    Selection.EntireRow.Insert
    ActiveWindow.SmallScroll Down:=8
    Range("A112").Select
    Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A113:A119").Select
    ActiveWindow.SmallScroll Down:=6
    Range("A120").Select
    Selection.EntireRow.Insert
    Range("A128").Select
    Selection.EntireRow.Insert
    Range("A136").Select
    Selection.EntireRow.Insert
End Sub
Todos os horários são UTC-03:00
Página 1 de 1
Powered by phpBB® Forum Software © phpBB Limited