Boa tarde.
Venho novamente pedir o auxilio de vocês.
Ao exportar os dados de uma planilha para outra desejo manter a mesma formatação da planilha de origem, porém isto não acontece.
Segue abaixo o código.
Pessoal, o arquivo é muito grande, não estou conseguindo anexar
Sub Exportar_Dados()
'
' Exportar_Dados Macro
'
'
Dim w As Worksheet
Dim senha As String
senha = "123"
Set w = Planilha3
Dim ulinha As Long
w.Activate
If w.ProtectContents = True Then
w.Unprotect senha
Selection.ClearContents
End If
Application.ScreenUpdating = False
Workbooks.Open (ActiveWorkbook.Path & "Material de Embalagem.xlsx")
Windows("Material de Embalagem.xlsx").Activate
ActiveSheet.Unprotect
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Windows("Material_Embalagem.xlsm").Activate
Range("A4").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows("Material de Embalagem.xlsx").Activate
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
Workbooks("Material de Embalagem.xlsx").Save
Workbooks("Material de Embalagem.xlsx").Close
Application.ScreenUpdating = True
Windows("Material_Embalagem.xlsm").Activate
w.Protect senha
End Sub
Não sei se é isso mas tente mudar:
Selection.PasteSpecial Paste:=xlPasteValues...
para
ActiveSheet.PasteSpecial Paste:=xlPasteValues
Abrç!
___________________________________________________________________________________________
Se a resposta atendeu sua dúvida, por favor, clique no Gostei e marque o Tópico como [Resolvido].
Att.
André Arruda
Não funcionou
Boa Tarde.
Segui as orientações, porém não funcionou como desejado.
Criei uma macro, porém o resultado não está saindo como esperado.
O arquivo exportação (Resultado final) não está igual ao original.
Se os valores forem iguais ao estoque bom somente fonte em negrito e fundo branco
Se os valores forem iguais ao estoque critico somente fonte em negrito e fundo vermelho
Se os valores forem iguais ao estoque excesso somente fonte em negrito e fundo azul.
[img][/img]
O arquivo exportado (Resultado a ser exportado)
Se os valores forem iguais ao estoque bom somente fonte em negrito e fundo branco
Se os valores forem iguais ao estoque critico somente fonte em negrito e fundo vermelho
Se os valores forem iguais ao estoque excesso somente fonte em negrito e fundo azul.
[img][/img]
Esqueci de postar a macro criada
Sub Exportar_Dados()
'
' Exportar_Dados Macro
'
'
Dim w As Worksheet
Dim senha As String
senha = "123"
Set w = Planilha3
Dim ulinha As Long
w.Activate
If w.ProtectContents = True Then
w.Unprotect senha
Selection.ClearContents
End If
Application.ScreenUpdating = False
Workbooks.Open (ActiveWorkbook.Path & "Material de Embalagem.xlsx")
Windows("Material de Embalagem.xlsx").Activate
ActiveSheet.Unprotect
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Selection.Copy
Windows("Material_Embalagem.xlsm").Activate
Range("A4").Select
'ActiveSheet.Paste
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows("Material de Embalagem.xlsx").Activate
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
Workbooks("Material de Embalagem.xlsx").Save
Workbooks("Material de Embalagem.xlsx").Close
Application.ScreenUpdating = True
Windows("Material_Embalagem.xlsm").Activate
w.Protect senha
' Range("A4:F6").Select
'Selection.Copy
'Windows("Material de Embalagem.xlsx").Activate
'Range("A7").Select
'ActiveSheet.Paste
' Range("E13").Select
'Windows("Material_Embalagem.xlsm").Activate
End Sub
Boa noite,
Anexe uma planilha de exemplo, assim fica mais fácil tentar ajudar.
att,