Ну вот в том-то и дело, что рекодер выделяет по именам. И в другой книге макрос не будет работать, поскольку там названия листов другие и количество. Я думал, как бы это сделать через индексы какие-нибудь.  
Т.е. если в примере 4*3+1=13 листов, то в другой книге для обработки их может быть например 5*3+1=16. вот мне надо скопировать с 1 по 6 (т.е. свод и 5 основных листов). Листы идут подряд.  
 
Работает команда Sheets(1).Select - для выделения одного листа или Sheets(Array(1, 2, 3)).Select - для выделения трёх *четко установленных листов*  
Как написать "диапазоном" - с 1 по k. k посчитать же можно k=((sheets.count-1)/3)

{quote}{login=Юрий М}{date=17.08.2008 05:21}{thema=}{post}1. Если обратите внимание, то увидите, что у листов в VBE два имени. Первое - присвоенное самой программой, второе - присвоенное Вами. А чтобы копировать только нужные (с ... по ...) нужно сначала их посчитать (макросом).{/post}{/quote}  
согласен. Вот мне и нужно выделить листы с 1 по (sheets.count-1)/3

{quote}{login=Юрий М}{date=17.08.2008 05:40}{thema=}{post}Я делал так:  
n = Sheets.Count  
For i = 2 To n - 2  
Т.е. в обработку попадали листы со второго по последний-2.{/post}{/quote}  
ммм... а можно полностью? что с этим циклом дальше-то делать? для обработки данных на заданных листах он годится, а копировать их все как в новую книгу?

Вот такая идея:  
Sub Макрос1()  
Dim s()  
k = 2  
ReDim s(1 To k)  
 
For i = 1 To k  
s(i) = i  
Next  
Sheets(s).Select  
End Sub  
Сначала получаем массив с номерами листов.  
Только надо предварительно определить k.  
Чтобы в массиве не было пустых элементов - даст ошибку.

Не могу понять, почему у меня не работает этот макрос,    
Ругается на Worksheets(dlt).Delete, пишет Subscript out of range.    
Есть идеи?  
Sub test1()  
 
Dim dlt()  
ReDim dlt(20)  
v = 1  
For x = 1 To Sheets.Count  
Sheets(x).Select  
If Range("B6") <> "" Then  
dlt(v) = x  
v = v + 1  
End If  
Next x  
ReDim Preserve dlt(v - 1)  
'For i = Sheets.Count To i Step -1  
'Cells(1, 1) = dlt(3)  
'Sheets(dlt).Select  
Sheets(dlt).Select  
'a = dlt(1)  
'Worksheets(dlt).Delete  
'Next i  
'Application.DisplayAlerts = False  
'Worksheets(Array(dlt)).Delete  
'Application.DisplayAlerts = True  
 
End Sub

Че так заморочено...  
Sub test1()  
   Dim x  
   For x = Sheets.Count To 2 Step -1  
       If Sheets(x).Range("B6") <> "" Then Sheets(x).Delete  
   Next x  
End Sub

Можно так Ваш код подправить, но конечно замороченно...  
Но номера из массива :)  
А я ещё недавно думал - кому может понадобиться в массив имена листов собирать, чтоб потом сразу все удалить, если это можно делать проще сразу по-одному?  
А вот подиж ты...  
 
 
Sub test1()  
   ReDim dlt(0)  
   v = 1  
   For x = 1 To Sheets.Count  
       If Sheets(x).Range("B6") <> "" Then  
           If v = 1 Then  
               dlt(v - 1) = x  
           Else  
               ReDim Preserve dlt(UBound(dlt) + 1)  
               dlt(v - 1) = x  
           End If  
           v = v + 1  
       End If  
   Next x  
   Worksheets(dlt).Delete  
End Sub  
 
 
Ещё DisplayAlerts вероятно нужно отключить.

Worksheets(dlt(0)).Delete