Este fórum está sendo desativado

Depois de 9 anos, este fórum será desativado. Mas calma.... estamos migrando para uma comunidade no DISCORD. Junte-se a nós.

ENTRAR PARA DISCORD

Tópicos relacionados a códigos VBA, gravação de macros, etc.
#55112
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
Editado pela última vez por Alexmanza em 23 Mai 2020 às 18:38, em um total de 1 vez.
#55125
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?
#55127
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
long long title how many chars? lets see 123 ok more? yes 60

We have created lots of YouTube videos just so you can achieve [...]

Another post test yes yes yes or no, maybe ni? :-/

The best flat phpBB theme around. Period. Fine craftmanship and [...]

Do you need a super MOD? Well here it is. chew on this

All you need is right here. Content tag, SEO, listing, Pizza and spaghetti [...]

Lasagna on me this time ok? I got plenty of cash

this should be fantastic. but what about links,images, bbcodes etc etc? [...]

Estamos migrando para uma comunidade no Discord