Public Sub www()
Dim lr&, wb As Workbook, lb As Workbook
Application.DisplayAlerts = False
Set wb = GetObject("c:\svod.xls") 'сюда пропишите свой путь к файлу итога
Set lb = ThisWorkbook
lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ActiveCell.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 1)
ActiveCell.EntireRow.Copy
wb.Sheets(1).Cells(lr + 1, 1).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False:Windows(wb.Name).Visible = True
wb.Close (True)
Set wb = Nothing: Set lb = Nothing
Application.DisplayAlerts = True
End Sub

Windows(wb.Name).Visible = True

wb.Close (True)

Sub Copy_ROW_to_FILE()
     Dim lr&, wb As Workbook, lb As Workbook
     With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With
     Set wb = GetObject("c:\test.xls")   'сюда пропишите свой путь к файлу итога
     Set lb = ThisWorkbook
     lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
     ActiveCell.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 1)
     Windows(wb.Name).Visible = True
     wb.Close (True)
     With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With
     Set wb = Nothing: Set lb = Nothing
End Sub

Windows(ThisWorkbook.Name).Visible = True

Private Sub Workbook_Open()
If Me.Parent.Caption = Application Then Windows(Me.Name).Visible = True
End Sub

Private Sub Workbook_Open()
     If Me.Parent.Caption = Application.Caption Then Windows(Me.Name).Visible = True
End Sub

Sub Copy_ROWs_to_EXT_FILE()   ' скопировать строки выделенных ячеек во внешний файл-накопитель
       '---------------------------------------------------------------------------------------
       ' Procedure    : Copy_ROWs_to_EXT_FILE
       ' Author       : KuklP & Alex_ST (незначительные доработки)
       ' Topic_HEADER : сделать чтобы выбранная строка копировалась в отдельный файл
       ' Topic_URL    : http://www.excelworld.ru/forum/2-170-2003-16-1293604578
       ' DateTime     : 29.12.10, 09:36
       ' Purpose      : скопировать строки выделенных ячеек во внешний файл-накопитель
       ' Notes        : после работы макроса файл-накопитель становит невидимым в обычных окнах Excel (как надстройка или Personal.xls)
       '---------------------------------------------------------------------------------------
       If Not TypeName(Selection) = "Range" Then Exit Sub
       Dim lr&, wb As Workbook, lb As Workbook
       With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With
       Set wb = GetObject("c:\test.xls")   'путь к файлу-накопителю
       Set lb = ThisWorkbook
       lr = wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
       Selection.EntireRow.Copy wb.Sheets(1).Cells(lr + 1, 1)
       wb.Close (True)   ' закрыть с сохранением
       With Application: .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: End With
       Set wb = Nothing: Set lb = Nothing
       'чтобы после работы макроса файл-накопитель не становился невидимым в окнах Excel, в нём нужно прописать:
       'Private Sub Workbook_Open()
       '   If Me.Parent.Caption = Application.Caption Then Windows(Me.Name).Visible = True
       'End Sub
End Sub