Enviar arquivo para pasta fechada

2024 - VBA & Macros

Post Recente por Fernando Fernandes 11 anos atrás

4 Posts

2 Usuários

0 Reactions

705 Visualizações

RSS

dimorais

(@dimorais)

Posts: 431

Reputable Member

Topic starter

Boa tarde
A macro abaixo (envia arquivos de uma pasta aberta para outra pasta aberta) funciona 100% para o fim a que se destina. No entanto precisava que a mesma enviasse o arquivo da pasta aberta para uma pasta fechada.

Dim wksIndex As Worksheet
Dim wksDistr As Worksheet
Application.ScreenUpdating = False

Set wksMap = Workbooks("#INDEXADOR#.xlsb").Worksheets("Indexadores")
Set wksDistr = Workbooks("#SISTEMA#.xlsb").Worksheets("Distribuição")

'--------------------Red-------------------------------------------------------
wksMap.Range("AE8:AG50").Copy
wksDistr.Range("BB7:BD48").PasteSpecial xlPasteValues

'-------------------Green-----------------------------------------------------
wksMap.Range("AM8:AO50").Copy
wksDistr.Range("BB60:BD110").PasteSpecial xlPasteValues

'-------------------White-----------------------------------------------------
wksMap.Range("AI8:AK50").Copy
wksDistr.Range("EH7:EJ48").PasteSpecial xlPasteValues

'-------------------Yellow---------------------------------------------------
wksMap.Range("AQ8:AS50").Copy
wksDistr.Range("EH60:EJ110").PasteSpecial xlPasteValues

Application.CutCopyMode = False
Range("DW7").Select
Application.ScreenUpdating = True
End Sub

Grato

Postado : 11/02/2014 1:08 pm

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Dimorais,

Blz? Como vc bem sabe VBA não é minha praia mas acredito que via gravador de macros vc mata a parada. Isso porque, até onde eu entendi, é necessário efetivamente ABRIR o segundo arquivo para colar valores.

Fuçando na internet acho que só dessa forma se faz o que vc quer.

O código abaixo deve funcionar (troque somente o diretório de C:Users para o seu).

Me avise.

Abs,

Sub Macro1()

    Windows("#INDEXADOR#.xlsb").Activate
    Sheets("Indexadores").Select
    Range("AE8:AG50").Select
    Selection.Copy
    Workbooks.Open Filename:="C:Users#SISTEMA#.xlsb"
    Sheets("Distribuição").Select
    Range("BB7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("#INDEXADOR#.xlsb").Activate
    Sheets("Indexadores").Select
    Range("AM8:AO50").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("#SISTEMA#.xlsb").Activate
    Sheets("Distribuição").Select
    Range("BB60").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("#INDEXADOR#.xlsb").Activate
    Sheets("Indexadores").Select
    Range("AI8:AK50").Select
    Selection.Copy
    Windows("#SISTEMA#.xlsb").Activate
    Sheets("Distribuição").Select
    Range("AI8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("#INDEXADOR#.xlsb").Activate
    Sheets("Indexadores").Select
    Range("AQ8:AS50").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("#SISTEMA#.xlsb").Activate
    Sheets("Distribuição").Select
    Range("EH60").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("DZ45").Select
    Selection.End(xlToLeft).Select
    Selection.End(xlUp).Select
    ActiveWorkbook.Save
    ActiveWindow.Close
    Application.CutCopyMode = False
    Windows("#INDEXADOR#.xlsb").Activate
    Sheets("Indexadores").Select
    Range("DW7").Select
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 11/02/2014 9:34 pm