Но если я правильно понял что вы хотите, то можно проще:  
 
Sub Format_Cells()  
For i = 7 To 12  
With Selection.Borders(i)  
   .LineStyle = xlContinuous  
   .Weight = xlThin  
   .ColorIndex = xlAutomatic  
End With  
Next  
Selection.RowHeight = 12.75  
End Sub

Удалите строку Range("A7:G45").Select  
Затем выделите что вам необходимо и запустите макрос.

[В1].End(xlDown).Offset(1, 0).Value = "Последняя свободная ячейка столбца В"

Private Sub Кнопка_Click()  
Static iFlag As Integer  
Select Case iFlag  
   Case 0: MsgBox "Макрос 1"  
   Case 1: MsgBox "Макрос 2"  
   Case 2: MsgBox "Макрос 3"  
   Case 3: MsgBox "Макрос 4"  
   Case 4: MsgBox "Макрос 5"  
   Case 5: MsgBox "Макрос 6" 'И т.д.  
   Case Else  
   iFlag = 0  
   MsgBox "Хватит!"  
   Exit Sub  
End Select  
iFlag = iFlag + 1  
End Sub

Ну если без макросов, то как вариант можно так

Попробуйте такой макрос:  
 
Sub Find_Duplicates()  
Dim iCell As Range, c  
Application.ScreenUpdating = False  
Columns("C:C").Insert  
Columns("B:B").AdvancedFilter xlFilterCopy, , Columns("C:C"), 1  
Columns("B:B").Delete  
For Each iCell In Range([B1], [B65536].End(xlUp))
   With Columns("A")  
       Set c = .Find(iCell, LookAt:=xlWhole)  
       If c Is Nothing Then  
           .End(xlDown).Offset(1, 0).Value = iCell.Value  
           .End(xlDown).Offset(1, 0).Interior.Color = vbGreen  
       End If  
   End With  
Next  
Application.ScreenUpdating = True  
End Sub

А если так:  
=СУММЕСЛИ(A$3:A$20;A2 & "*";B$3:B$20)

Попробуй with ActiveWorkbook.

А почему сразу из форм не вставлять результаты как надо в одну строчку?

Ну так а что вам мешает ввести соответствующие формулы в нужные ячейки и скопировать на весь диапазон?

Dim iLC As Integer  
With Workbooks("Куда копировать")  
iLC = .Sheets.Count  
Workbooks("Откуда копировать").Worksheets(1).Copy After:= .Worksheets(iLC)  
End with

Я не знаю чего вы там плакаль, я цитировал код девушки.  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   If Target.Cells.Count > 1 Then Exit Sub  
       Application.ScreenUpdating = True  
       If Not Intersect(Target, Range("A15:D15")) Is Nothing Then  
       MsgBox ... Вот это выполнится при совпадении диапазона  
       End If  
А вот это в любом случае  
 
           With ActiveSheet.PageSetup  
               .LeftFooter = Range("A21")  
               .CenterFooter = Range("A22")  
               .RightFooter = "&P"  
           End With  
 Dim NewName As String, WsExist As Boolean  
 On Error Resume Next и т.д.  
   
Разве я не прав?

Всё равно как-то всё мутно. Ну по крайней мере чтоб макрос выполнялся только при изменении в "A15:D15", надо всё тело поместить внутрь условия  
       If Not Intersect(Target, Range("A15:D15")) Is Nothing Then  
  ................  
       End If  
А у вас только сообщение внутри. И попытайтесь еще раз подробно какой лист откуда шаблоном и куда и при каком условии и где обе книги лежат.

ActiveSheet.Next.[A1].Value = TextBox1.Text

Сейчас попробовал у себя - жать устал на 100 странице. Возможно у вас слишком "тяжелые" страницы и не хватает оперативной памяти самого компьютера.

{quote}{login=Марая}{date=04.05.2010 01:11}{thema=Копировать лист в активную книгу}{post}Здравствуйте!  
 
 Помогите с макросом. Надо чтобы в активную книгу вставлялся лист из закрытой книги как бланк. И еще одна просьба в помощи или совете. "Слепила" макрос по вставке колонтитула и переименования листа при изменении данных в определенной ячейке, но что-то сделала не так. Макрос запускается при изменении в любой ячейке.{/post}{/quote}  
 
Как мне показалось у вас там много лишнего и формулы гигантские. Сырое всё. Напишите подробно что надо, помогу судя по всему землячке. :)

With Selection  
   .Resize(.Rows.Count, .Columns.Count - 1).PrintOut  
End With

Только перед запуском макроса убедитесь, что лист, который хотите копировать активен.

Для этого можно воспользоваться вот таким макросом:  
 
Sub Copy()  
 Dim iLc As Integer  
 iLc = ActiveWorkbook.Sheets.Count  
 ActiveSheet.Copy After:=Worksheets(iLc)  
 ActiveSheet.Name = iLc + 1  
End Sub

Для именования ячейки или диапазона надо выделить нужное, идти в меню Втавка -> Имя -> Присвоить, и ввести желаемое имя без пробелов. Обращатся к именованной ячейке или диапазону можно так: Range("Имя")

Вот готовый файл:

Если вдруг чего то непонятно описал:

Чем вас не устроил вариант с форматированием?  
 
Выделяешь столбец "I", жмешь Ctrl + 1, Закладка "Число", далее выбираешь в списке слева "(все форматы)" (в самом низу), в поле "Тип" справа вводишь "+0;-0;0" без кавычек, жмешь ОК. Всё!

Всё просто.  
 
Sub Макрос1()  
Selection.PrintOut  
End Sub

Selection.PrintOut