Bom dia.
Veja se te ajuda.
A única parte que ficou sem entendimento pra mim foi em qual worksheet dos arquivos a macro irá trabalhar então, eu chutei e coloquei no código que é a primeira sheet.
Se não for CORRIJA ISSO!!!
Sub Executar()
On Error GoTo erro_executa
Dim arq() As Variant
Dim wbnew As Workbook, wb As Workbook
Dim wnew As Worksheet
Dim c As String
arq = Application.GetOpenFilename("arquivos do excel (*.xl*),*.xl*", MultiSelect:=True)
Set wb = ThisWorkbook
Application.ScreenUpdating = False
For A = LBound(arq()) To UBound(arq())
arquivoAberto = arq(A)
Application.Workbooks.Open arquivoAberto
Set wbnew = ActiveWorkbook
wbnew.Worksheets(1).Activate 'É aqui que vc vai alterar se for o caso...
Set wnew = ActiveSheet
'-------------------------
Range("B60").Select
Selection.EntireRow.Insert
Selection.EntireRow.Insert
Range("C62").Select
Selection.Copy
Range("C60").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Abertura e fechamento de módulos ( vazio)"
Range("C62").Select
Selection.Copy
Range("C61").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Abertura e fechamento de módulos (carregado)"
Range("C63").Select
Selection.Copy
Range("C62").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"Funcionamento de travas das cabeceiras e centrais (vazio)"
Range("C63").Select
ActiveCell.FormulaR1C1 = _
"Funcionamento de travas das cabeceiras e centrais (carregado)"
Range("C49").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range("C49:E50").Select
Selection.Copy
Range("C51:E72").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("F49:I50").Select
Selection.Copy
Range("F51:I72").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("J59").Select
Selection.AutoFill Destination:=Range("J59:J62"), Type:=xlFillDefault
Range("J59:J62").Select
Range("B57:B58").Select
Selection.AutoFill Destination:=Range("B57:B63"), Type:=xlFillDefault
Range("B57:B63").Select
'------------------------
Application.DisplayAlerts = False
wbnew.Close True
Application.DisplayAlerts = True
Next A
Application.ScreenUpdating = True
wb.Worksheets(1).Select
MsgBox "Concluído"
Exit Sub
erro_executa:
Application.ScreenUpdating = True
MsgBox "Ocorreu um erro"
End Sub
Resposta útil? Clique na mãozinha ao lado do botão Citar.
Postado : 09/10/2017 3:36 pm