Este fórum está sendo desativado

[fazerbem]

Onde esta o erro aqui ?

Na Plan1 quero que copie a celula C4 para a Plan2 C8. Sendo que A7:E7 esta tudo preenchido.

Entao quero que ao rodar a macro fique em Plan2 coluna C o seguinte, conforme se rodar a mesma vai indo pra baixo,

Loja 1
Loja 2
Loja 3 ... ( ate a C21 )



Sub Macro8()

Dim Ws1 As Worksheet
Dim Ws2 As Worksheet

Dim Dest As Range


Set Ws1 = Sheets("Plan1") 'Referencia a guia Resumo como Ws1

Set Ws2 = Sheets("Plan2") 'Referencia a guia Plan1 como Ws2

Set Dest = Ws2.Range("C8").Range("C21").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)

Ws1.Range("C4").Copy 'Copia o intervalo C4 da guia Resumo
Dest.PasteSpecial xlPasteValues 'Cola valores na guia Comissão
Application.CutCopyMode = False



End Sub

[Parkeless]

E aí André, beleza?

Testei o código aqui, e ele parece estar funcionando ._. o problema é que ele está colando na coluna D ao invés da C? se for isso, só trocar a linha:

Código: Selecionar todos

Set Dest = Ws2.Range("C8").Range("C21").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)

Por essa:

Código: Selecionar todos

Set Dest = Ws2.Range("C8").Range("C21").End(xlUp).Offset(1, -2) 'Encontra a ultima linha da guia comissão (definida como Dest)

[fazerbem]

Aqu não ta dando, tb não sei o motivo, amanha se não conseguir mando as 2 planilhas ok ?

[alexandrevba]

Bom dia!!

favor indicar a postagem cruzada!!
http://www.planilhando.com.br/forum/vie ... 10&t=18308

Outra coisa, não poste uma dúvida em um poste, depois quebre ela em parte em outros post, isso polui o fórum!!!

Att

[fazerbem]

Segue anexo a plainilha modelo

Rode a macro e vera que nao pula a linha conforme executar a macro

O certo seria toda vez que rodar a macro
entre C7 a C21 ir colando Loja um apos o outro .

Grato

[fazerbem]

Alexandre Bom dia, postei sim , fiz o cadastro ontem la tb, pois achei que vcs aqui ja haviam se cansado de mim.

coloquei acima a planilha se puder ajudar serei grato.

[Parkeless]

Troca a linha:

Código: Selecionar todos

Set Dest = Ws2.Range("C8").Range("C21").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)

Por:

Código: Selecionar todos

Set Dest = Ws2.Range("C1000000").End(xlUp).Offset(1, 0) 'Encontra a ultima linha da guia comissão (definida como Dest)

Assim ela vai colar SEMPRE uma linha abaixo da última célula preenchida na coluna C.

Te atende?

[fazerbem]

Opa Amigao, ta quase la. Pois se vc rodar ai vera que vai comecar a colar na celula C2 , mas queria que começasse a colar somente no intervado de C7 a C21 somente.

Mas precisei fazer aqui uma ultima modificacao e segue no anexo a nova Plan. A senha desbloqueio e 1234, coloquei a senha pois sera com senha e obrigatoriamente tera que ser nas celulas a colagem.

Grato

[Parkeless]

Vê se é isso

Tirei as mesclagens das linhas, mas mantive das colunas ok?

Cuidado se for mudar as mesclagens dela; pode parar de funcionar...

Sempre que puder evite mesclagens, isso só dá dor de cabeça ^^'

Mudei o código para:

Código: Selecionar todos

Sub Macro8()

Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Valor_a_colar As String

Dim Dest As Range


Set Ws1 = Sheets("Plan1") 'Referencia a guia Resumo como Ws1

Set Ws2 = Sheets("Plan2") 'Referencia a guia Plan1 como Ws2

'Definir destino
Dim cell As Range
For Each cell In Range("B7:B20")
    cell.Select
    If cell = "" Then
        Set Dest = cell
        GoTo Final
    End If
Next cell
For Each cell In Range("D7:D20")
    If cell = "" Then
        Set Dest = cell
        GoTo Final
    End If
Next cell

Final:

Valor_a_colar = Ws1.Range("A1")  'Copia o intervalo C4 da guia Resumo
Dest = Valor_a_colar 'Cola valores na guia Comissão
Application.CutCopyMode = False



End Sub

[fazerbem]

Parkless, vc é mesmo " F ", era isso mesmo que eu queria cara, muito obrigado mesmo !!!

Tenho outros 2 problemas rsrsrs, vc me ajuda ? segue os links.

http://www.planilhando.com.br/forum/vie ... 10&t=18325

http://www.planilhando.com.br/forum/vie ... 10&t=18319

Grato amigo, muito obrigado mesmo

Andre

[fazerbem]

ParkLess, deu pra ver acima ?

Vou abusar mais um pouco do amigo, seu comando acima ficou pra lá do esperado. Entao queria que ao criar cada Loja. fosse agregado ao nome um Link.

Vou explicar, a minha Tabela aqui esta redondinha, e esta macro que vc me fez, é para ser colocado todos os PEdidos que ainda nao foram aprovados. O que sao aprovados eles nao entram ai pois e atraves de outra Macro. Enato cada vez que gero um pedido e este requer ainda aprovacao, ele fica em Stand BY, e pra isso crieii uma macro que cria a nova Planilha com o nome da Celula que eu identifico no pedido como nome fantasia. Entao se tenho e novas abas criadas aguardando a aprovacao, conforme seu comando feito, elas vao aparecer ao lado. como cada quadradinho possui uma loja diferente, neste exemplo sao 3, quero que ao ser criada cada uma dessas lojas, cada uma seja tenha um link , que ao clicar direciona a aba desta Loja. Se criou as Abas LOja 1, Loja 2 e Loja 3, se clico na Loja 1 me direciona a aba da Loja 1. Estou pedindo isso para que eu nao precise procurar a loja na barra de rolagem.

APos ser aprovado o pedido, entao aciono outra macro que envia o pedido , salva a minha comissao deste pedido e exclui esta pasta que é temporaria.

Seu comando agreguei na mesma Macro que uso para criar a nova Aba . Ja testei e ficou SHOW !!!

Grato.

[Parkeless]

Peraí cara, é muita coisa de uma vez ._.

Não tenho cadastro em outros fóruns, então não vou poder te ajudar em links externos... mas de qualquer forma dei uma olhada por cima, e ainda não manjo muito de integração entre Excel e Outlook, nem de exportação.

Quanto ao hiperlink, talvez fosse mais fácil fazer um worksheet_change, mas posta a planilha denovo descrevendo o que você quer (de preferência especificando bem as células e abas), que bolo alguma coisa e mando pra você. Lendo, assim, é meio difícil.

[fazerbem]

Ola amigo segue no anexo

Grato de novo

Andre

[Parkeless]

Segue

Agora tudo o que você colocar no intervalo B7:E20 vai funcionar como um link para uma aba de mesmo nome; se não achar, vai retornar um erro.

[fazerbem]

Amigo, chegeui em casa agora, meu note esta na lija, amanha vou tastar ancisamente. O lance do email um amigo lamdo outro forum me ajudou. Cara, excel e muito bom tem muito recurso, minha 2 Tabelas ficaram perfeitas. So agora a resolver o detalhe da validade . Amanha eu posto aqui a tabela pra ver se pode me ajudar, falta so um detalhe, que vc vera. Abracos e uma Otima noite.

[fazerbem]

Ola PakLes, bom dia.

é quase isso, mas nao é ainda.

esta rotina vai ficar dentro do comando abaixo. Repare que eu ja o coloquei, o que me enviou primeiro. Funcionou que uma maravilha. so nao tinha o Link.

Da forma que fez agora, eu teria que por ele no final do comando abaixo. Pois se a planilha nao tiver ainda criado a aba ele trava. ate ai tudo bem, e so jogar pra baixo. Mas note o que acontece com o anexo que te envio, siga as orientacoes da tela.

A macro abaixo, cria uma Aba que fica aguardando autorizacao do Cliente, mas ainda nao o envia a empresa.

E se nao for pedir muito, eu tenho uma outra macro, que nao é esta de baixo, que ao enviar o pedido ela exclui a aba, desta forma teria como eu adaptar nesta macro de envio uma rotina que fosse la na Plan1, apagasse a loja em B7:D20, vai depender onde ela estiver e remanejasse as outras lojas para que a rotina funcionasse, caso contrario ficara linhas em branco. vou dar um exemplo

em B7:D20 esta assim:

LOja do Joao
Loja da Maria
Loja do Pedro
Lojas do Antonio
Loja da Ana

Quando eu enviar o pedido a empresa, a minha Macro abaixo, envia o pedido por email, e exclui a Aba Pedro. Veja que criou uma linha em branco. Entao antes desta macro termine, eu quero acrescentar uma rotina, que vai na pasta Plan1, exclui a Loja do Pedro, seleciona a Loja do Antonio e da Ana e remaneja pra cima. A mesma coisa se vale para as que estiverem na coluna D

Segue abaixo o testamento, como nao entendo de Macro, usei o Gravado de Macro e as dicas que pego aqui e juntei as 2, esta tudo operacional, so falta o Link ficar.


Outra coisa, eu vi que dentro da Macroque vc enviou ,esta igual a outra, entao imagino que o link esteja dentro da area B:D mas onde ?


Sub Criar_Planilha_Pedido()

Dim Wp1 As Worksheet
Dim Wp2 As Worksheet
Dim Valor_a_colar As String

Dim Dest As Range


Set Wp1 = Sheets("RESUMO") 'Referencia a guia Resumo como Ws1


'Definir destino
Dim cell As Range
For Each cell In Range("B8:B21")
cell.Select
If cell = "" Then
Set Dest = cell
GoTo Final
End If
Next cell
For Each cell In Range("D8:D21")
If cell = "" Then
Set Dest = cell
GoTo Final
End If
Next cell

Final:

Valor_a_colar = Range("H10") 'Copia o intervalo C4 da guia Resumo
Dest = Valor_a_colar 'Cola valores na guia Comissão
Application.CutCopyMode = False


Dim Ws1 As Worksheet
Dim nome
nome = Range("C5")

Set Ws1 = Sheets("RESUMO")

Application.ScreenUpdating = 0 'Deixa a macro mais rápida (Desliga a tela de atualização)

Sheets.Add ' inseri uma nova planilha
nome = Sheets("RESUMO").Range("H10")
ActiveSheet.Name = nome ' renomeia a planilha
Sheets("RESUMO").Select

Sheets("MODELO FRETE").Select

Range("A1:w80").Select
Selection.Copy
Sheets(nome).Select
Rows("1:1").RowHeight = 14.25
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rows("1:1").RowHeight = 11.25
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


'copiar o novo botao que ainda vou criar aqui




Sheets("Modelo Frete").Select
ActiveSheet.Shapes.Range(Array("Picture 3")).Select
Selection.Copy
Sheets(nome).Select
Range("O2:Q3").Select
ActiveSheet.Paste
Rows("2:2").RowHeight = 18.75
Rows("3:3").RowHeight = 13.5
Selection.ShapeRange.IncrementLeft 37.5
Selection.ShapeRange.IncrementTop 2.25

Sheets("PEDIDO G").Select
Range("A53:A55").Select
Selection.Copy
Sheets(nome).Select
Range("C30").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PEDIDO G").Select
Range("C53:C55").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("E30").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("MODELO FRETE").Select
Range("AA2:AG3").Select
Selection.Copy
Sheets(nome).Select
Range("AA2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Sheets("RESUMO").Select
Range("AC2:AH2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("AB3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("MODELO FRETE").Select
Range("C23:E23").Select
Selection.Copy
Sheets(nome).Select
Range("C23:E23").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("MODELO FRETE").Select
Range("C25:C27").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("C25:C27").Select
ActiveSheet.Paste

Sheets("MODELO FRETE").Select

Range("X2:Y3").Select
Selection.Copy
Sheets(nome).Select
Range("X2").Select
ActiveSheet.Paste
Sheets("MODELO FRETE").Select
Range("Y2:Y3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("Y2").Select

Sheets("MODELO FRETE").Select

Range("X2:X3").Select
Selection.Copy
Sheets(nome).Select
Range("X2").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Sheets("MODELO FRETE").Select
Range("Y2:Y3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select

Range("Y2").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Sheets("MODELO FRETE").Select
Range("X1:Y1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("X1").Select
ActiveSheet.Paste
Range("X2:Y3").Select
Application.CutCopyMode = False
Selection.Copy
Range("X16").Select
ActiveSheet.Paste
Range("X22").Select
ActiveSheet.Paste


Range("X41").Select
ActiveSheet.Paste
Range("X52").Select
ActiveSheet.Paste
Sheets("MODELO FRETE").Select
Range("X4:Y15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("X4").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("MODELO FRETE").Select
Range("X18:Y21").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("X18").Select

Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("MODELO FRETE").Select
Range("X24:Y40").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("X24").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Sheets("MODELO FRETE").Select
Range("X43:Y51").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("X43").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("MODELO FRETE").Select
Range("X54:Y62").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("X54").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("X2:Y62").Select
Range("X62").Activate
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("X63:Y80").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0
.PatternTintAndShade = 0
End With


Sheets("RESUMO").Select
Range("H10:J10").Select

Selection.Copy

Sheets(nome).Select

Range("C5").Select
'ActiveSheet.Paste

'cola na pasta largura criada (1)a largura coluna e (2)os dados
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False '(1)
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False '(2)

Application.CutCopyMode = False 'Desativaj o clipboard

Sheets("RESUMO").Select
Range("H14:J14").Select
Selection.Copy
Sheets(nome).Select
Range("C7:E10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C7:E10").Select

Application.CutCopyMode = False 'Desativaj o clipboard


Sheets("RESUMO").Select
Range("H20:J25").Select
Selection.Copy
Sheets(nome).Select
Range("C11:E16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C11:E16").Select

Application.CutCopyMode = False 'Desativaj o clipboard

Sheets("MODELO FRETE").Select

Range("A1:R56").Select
Selection.Copy
Sheets(nome).Select
Rows("1:1").RowHeight = 14.25
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rows("1:1").RowHeight = 11.25

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Sheets("RESUMO").Select

Range("N3:T4").Select
Selection.Copy
Sheets(nome).Select
Range("G5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("RESUMO").Select
Range("N5:T5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("G7:M7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Sheets("RESUMO").Select
Range("N6:P6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("G8:I8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("RESUMO").Select
Range("Q6:T6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("J8:M8").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RESUMO").Select
Range("N7:Q7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("G9:J9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RESUMO").Select
Range("R7:T7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("K9:M9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RESUMO").Select
Range("N8:P9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("G10:I10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RESUMO").Select
Range("Q8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("J10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RESUMO").Select
Range("R8:T8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("K10:M10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RESUMO").Select
Range("Q9:T9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("J11:M11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RESUMO").Select
Range("N12:P51").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("G14:I14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RESUMO").Select

Range("Q12:Q51").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("J14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RESUMO").Select

Range("R12:R51").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("K14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RESUMO").Select

Range("S12:T53").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("L14:M14").Select
Sheets("RESUMO").Select

Range("S12:T51").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("RESUMO").Select
Range("Q52:T53").Select
Sheets(nome).Select

Sheets("RESUMO").Select
Range("S52:T53").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select

Range("L54:M55").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("P9:Q23").Select
Application.CutCopyMode = False
Selection.Copy


Sheets("RESUMO").Select

Range("W7:X8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("RESUMO").Select
Range("W9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("P11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("P:P").ColumnWidth = 5.29
Columns("P:P").ColumnWidth = 4.29
Sheets("RESUMO").Select
Range("X9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("Q11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("Q:Q").ColumnWidth = 10.57
Sheets("RESUMO").Select
Range("W10:X13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("P12:Q12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Sheets("MODELO FRETE").Select
Range("C15").Select
Selection.Copy
Range("P16:Q17").Select
ActiveSheet.Paste Link:=True
Application.CutCopyMode = False
ActiveSheet.Unprotect
Range("C15:E16").Select
Selection.Copy
Range("P16:Q17").Select
ActiveSheet.Paste Link:=True
Range("C17:E18").Select
Application.CutCopyMode = False
Selection.Copy
Range("P18:Q19").Select
ActiveSheet.Paste Link:=True
Application.CutCopyMode = False

Sheets(nome).Select

'Formulas Frete e Envio

Range("P16:Q17").Select
ActiveCell.FormulaR1C1 = "=IF(R[-1]C[-13]="""","""",R[-1]C[-13])"
Range("P18:Q19").Select
ActiveCell.FormulaR1C1 = "=IF(R[-1]C[-13]="""","""",R[-1]C[-13])"
Range("P20:Q21").Select


Range("C11").Select
Selection.Copy
Range("C21:E22").Select
ActiveSheet.Paste Link:=True


Sheets("MODELO FRETE").Select
Application.CutCopyMode = False
Range("P16:Q17").Select
Selection.Copy
Range("R16").Select
ActiveSheet.Paste Link:=True
Range("P18:Q19").Select
Application.CutCopyMode = False
Selection.Copy
Range("R18").Select
ActiveSheet.Paste Link:=True
Range("S20").Select
Application.CutCopyMode = False

Sheets("RESUMO").Select
Range("W18:X19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("P20:Q21").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("RESUMO").Select
Range("W20:X21").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("P22:Q23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P22:Q23").Select
Selection.FormatConditions.Delete


Application.CutCopyMode = False


Sheets("Pedido G").Select
Range("G60").Select
Selection.Copy
Sheets(nome).Select
Range("P24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With Selection.Font
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0
End With

Sheets("RESUMO").Select


Sheets("MODELO FRETE").Select
Range("AI1:AP53").Select
Selection.Copy
Sheets(nome).Select
Range("AI1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Range("Z1:AH1").Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("Z2:Z12").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("AA12:AH12").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("AA4:AH12").Select
Range("AA12").Activate
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("AH2:AH3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0
.PatternTintAndShade = 0
End With





ActiveWindow.SmallScroll ToRight:=-13
ActiveWindow.SmallScroll ToRight:=-6



Sheets("MODELO FRETE").Select

ActiveSheet.Shapes.Range(Array("Bevel 2")).Select

Selection.Copy
Sheets(nome).Select
Range("D25").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 8.25
Selection.ShapeRange.IncrementTop 4.5
Range("P16:Q17").Select
Columns("Q:Q").ColumnWidth = 11.86
Range("C5:E6").Select

Sheets("PEDIDO G").Select
Range("C3:G3").Select
Selection.Copy
Sheets(nome).Select
Range("AK3:AO3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PEDIDO G").Select
Range("C5:E5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("AK5:AM5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PEDIDO G").Select
Range("F5:G5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("AN5:AO5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PEDIDO G").Select
Range("F6:G6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("AN6:AO6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PEDIDO G").Select
Range("C7:G7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("AK7:AO7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PEDIDO G").Select
Range("A8:B8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("AI8:AJ8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PEDIDO G").Select
Range("A9:B9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("AI9:AJ9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PEDIDO G").Select
Range("C8:D8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("AK8:AL8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PEDIDO G").Select
Range("C9:D9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("AK9:AL9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PEDIDO G").Select
Range("E8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("AM8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PEDIDO G").Select
Range("F8:G8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("AN8:AO8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PEDIDO G").Select
Range("E9:G9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("AM9:AO9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("PEDIDO G").Select
Range("E10:G10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets(nome).Select
Range("AM10:AO10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


' Aqui copia itens Pedido G para nome

Sheets("PEDIDO G").Select
Range("A12:G51").Select
Selection.Copy
Sheets(nome).Select
Range("AI13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False




Range("P9:Q9").Select
Selection.Copy
Range("R9").Select
ActiveSheet.Paste Link:=True
Range("P10:Q10").Select
Application.CutCopyMode = False
Selection.Copy
Range("R10").Select
ActiveSheet.Paste Link:=True
Range("P11").Select
Application.CutCopyMode = False
Selection.Copy
Range("R11").Select
ActiveSheet.Paste Link:=True
Range("Q11").Select
Application.CutCopyMode = False
Selection.Copy
Range("S11").Select
ActiveSheet.Paste Link:=True
Range("P12:Q12").Select
Application.CutCopyMode = False
Selection.Copy
Range("R12").Select
ActiveSheet.Paste Link:=True
Range("P13:Q13").Select
Application.CutCopyMode = False
Selection.Copy
Range("R13").Select
ActiveSheet.Paste Link:=True
Range("P14:Q14").Select
Application.CutCopyMode = False
Selection.Copy
Range("R14").Select
ActiveSheet.Paste Link:=True
Range("P15:Q15").Select
Application.CutCopyMode = False
Selection.Copy
Range("R15").Select
ActiveSheet.Paste Link:=True
Range("P16:Q17").Select
Application.CutCopyMode = False
Selection.Copy
Range("R16").Select
ActiveSheet.Paste Link:=True
Range("P18:Q19").Select
Application.CutCopyMode = False
Selection.Copy
Range("R18").Select
ActiveSheet.Paste Link:=True
Range("P20:Q21").Select
Application.CutCopyMode = False
Selection.Copy
Range("R20").Select
ActiveSheet.Paste Link:=True
Range("P22:Q23").Select
Application.CutCopyMode = False
Selection.Copy
Range("R22").Select
ActiveSheet.Paste Link:=True

Application.CutCopyMode = False

Application.ScreenUpdating = 1 'Deixa a macro mais rápida (Liga a tela de atualização)

Sheets(nome).Select


Run "Limpar"



End Sub

[fazerbem]

Escrevi errado

Quando eu enviar o pedido a empresa, a minha Macro abaixo, envia o pedido por email, e exclui a Aba Pedro. Veja que criou uma linha em branco.

o certo é

Quando eu enviar o pedido a empresa, uma outra macro que nao e a rotina que enviei aqui, envia o pedido por email, e exclui a Aba Pedro........

[fazerbem]

Eu nao entendo de Vba, mas fuçando aqui acrescentei 2 linhas no comando, e nao é que deu certo !! Reparei que sempre que dava o erro, depurava e voltava na Aba Plan1 e entao ia.

Sub Macro8()

Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Valor_a_colar As String
Dim Dest As Range
Set Ws1 = Sheets("Plan1") 'Referencia a guia Resumo como Ws1
'Definir destino
Dim cell As Range
For Each cell In Range("B7:B20")


'Acrescentei estas 2 linhas abaixo

Sheets("plan1").Select
Range("L8").Select





cell.Select
If cell = "" Then
Set Dest = cell
GoTo Final
End If
Next cell
For Each cell In Range("D7:D20")
If cell = "" Then
Set Dest = cell
GoTo Final
End If
Next cell

Final:

Valor_a_colar = Range("L8") 'Copia o intervalo C4 da guia Resumo
Dest = Valor_a_colar 'Cola valores na guia Comissão
Application.CutCopyMode = False



End Sub

[Parkeless]

Ahn... ._.

Resolveu então?

[fazerbem]

Ahn... ._.

Resolveu então?

O restante tem como fazer ?

" E se nao for pedir muito, eu tenho uma outra macro, que nao é esta de baixo, que ao enviar o pedido ela exclui a aba, desta forma teria como eu adaptar nesta macro de envio uma rotina que fosse la na Plan1, apagasse a loja em B7:D20, vai depender onde ela estiver e remanejasse as outras lojas para que a rotina funcionasse, caso contrario ficara linhas em branco. vou dar um exemplo

em B7:D20 esta assim:

LOja do Joao
Loja da Maria
Loja do Pedro
Lojas do Antonio
Loja da Ana