Также все эти данные идут блоками. Так что нужно ещё наладить корректный переход между блоками. Так что я указал как данные идут в 1-м блоке, далее структура сохраняется, но вот номер строки уже меняется.

Забыл сказать, используется Module1. В нем есть блок ' Organize Pre-Picking list  
Там подписано коментариями откуда что берется.  
Например:    
1. Номер РО это ячейка Е5 на листе zwf30, причем только если в D5 стоит 1;  
2. Дата это лист zdlbestell ячейка J4;  
3. Номер поставщика - лист zdlbestell ячейка R4;  
4. Название поставщика - лист zdlbestell ячейка R5;  
5. Номер артикула MDLS это лист zdlbestell колонка D и этому артикулу должен соответствовать номер артикула из zwf30 колонки J (как на листе Sheet4);  
6. Заполняться будет в ручную;  
7. Наименование артикула берется из zdlbestell колонка I первая строка в каждом блоке и название должно соответствовать номеру артикула;  
8. Заполняться будет в ручную;  
9. Номер ТЦ берется из zwf30 колонки AH;  
10. Кол-во заказанного берется из zwf30 колонки I;  
11. Заполняться будет в ручную.

Необходимо сформировать отчет макросом как на листе Sheet4.  
Часть информации берется с листа zwf30, а часть с zdlbestell. При этом название артикула должно соответствовать его номеру.  
Помогите пожалуйста. Бьюсь уже 2 день.

{quote}{login=Юрий М}{date=20.05.2011 02:51}{thema=}{post}Совет ikki помог. Задача решена?{/post}{/quote}  
Да, задача решена.  
Спасибо всем.  
 
А код я и сам догадываюсь что можно ополовинить. У меня просто стаж кодинга в екселе только неделя :) Вот и отсюда гигантизм кода.

{quote}{login=Юрий М}{date=20.05.2011 02:51}{thema=}{post}Совет ikki помог. Задача решена?{/post}{/quote}  
Сейчас у нас возникли проблемы с работой терминальной системы. Так что нормальаня работа Экселя невозможна. Почти все виснет сразу. Как только у нас проблему исправят, проверю и сообщу. Но думаю что поможет.

{quote}{login=Юрий М}{date=20.05.2011 02:40}{thema=}{post}Shaitan, в свою очередь будьте любезны глянуть - КТО Вам писал это сообщение.{/post}{/quote}  
Простите, был не прав.

{quote}{login=Юрий М}{date=20.05.2011 02:28}{thema=Re: }{post}{quote}{login=KukLP}{date=20.05.2011 02:16}{thema=}{post}Юр, да мож не надо тут пример{/post}{/quote}  
Серж, а ты считаешь, что лучше такую "портянку" выкладывать?{/post}{/quote}  
Ну для начала,"ТЕКСТ МАКРОСА - ГДЕ?!"(орфография сохранена) Вы мне именно это написали. Вот я Вам текст макроса и выложил. Так что в следующий раз, будьте любезны, точнее выражать ваши желания, ибо они могут сбыться в точности так как просите.

Вот файл. Макрос Pre_Picking

Sub Pre_Picking()  
' Define  
Dim lstX As Long  
Dim resX As Long  
Dim k, k1, k2, N, r As Long  
 
' Удаление пустых строк  
   Sheet2.Select  
     
   LastRow = Sheet2.UsedRange.Row - 1 + Sheet2.UsedRange.Rows.Count  
   Application.ScreenUpdating = False  
   For r = LastRow To 1 Step -1  
       If Application.CountA(Rows®) = 0 Then Rows®.Delete  
   Next r  
 
' Разметка опорных ячеек для zdlbestell  
   Sheet1.Select  
   Range("A2").Select  
   ActiveCell.FormulaR1C1 = "1"  
   Range("A3").Select  
   ActiveCell.FormulaR1C1 = "2"  
   Range("A4").Select  
   ActiveCell.FormulaR1C1 = "3"  
   Range("A5").Select  
   ActiveCell.FormulaR1C1 = "4"  
   Range("A6").Select  
   ActiveCell.FormulaR1C1 = "5"  
   Range("A7").Select  
   ActiveCell.FormulaR1C1 = "6"  
   Range("A8").Select  
   ActiveCell.FormulaR1C1 = "7"  
   Range("A9").Select  
   ActiveCell.FormulaR1C1 = "8"  
   Range("A10").Select  
   ActiveCell.FormulaR1C1 = "9"  
   Range("A11").Select  
   ActiveCell.FormulaR1C1 = "10"  
   Range("A12").Select  
   ActiveCell.FormulaR1C1 = "11"  
   Range("A13").Select  
   ActiveCell.FormulaR1C1 = "12"  
   Range("A14").Select  
   ActiveCell.FormulaR1C1 = "13"  
   Range("A15").Select  
   ActiveCell.FormulaR1C1 = "14"  
   Range("A16").Select  
   ActiveCell.FormulaR1C1 = "15"  
   Range("A17").Select  
   ActiveCell.FormulaR1C1 = "16"  
   Range("A18").Select  
   ActiveCell.FormulaR1C1 = "17"  
   Range("A19").Select  
   ActiveCell.FormulaR1C1 = "18"  
   Range("A20").Select  
   ActiveCell.FormulaR1C1 = "19"  
   Range("A21").Select  
   ActiveCell.FormulaR1C1 = "20"  
   Range("B2").Select  
   ActiveCell.FormulaR1C1 = "2"  
   Range("C2").Select  
   ActiveCell.FormulaR1C1 = "3"  
     
     
 
     
     
' Initialize  
lstX = 1  
resX = 1  
k = 1  
 
' Organize Pre-Picking list  
Set res = Sheets.Add  
res.Cells(1, 1).Value = "Номер PO"            ' 1 zwf30  
res.Cells(1, 2).Value = "Дата PO"    ' 2 zdlbestell  
res.Cells(1, 3).Value = "Номер поставщика"      ' 3 zdlbestell  
res.Cells(1, 4).Value = "Название поставщика"    ' 4 zdlbestell  
res.Cells(1, 5).Value = "Номер артикула MDLS"        ' 5 zwf30  
res.Cells(1, 6).Value = "Номер артикула поставщика"   ' 6  
res.Cells(1, 7).Value = "Наименование артикула"      ' 7 zdlbestell  
res.Cells(1, 8).Value = "Содержание короба"     ' 8  
res.Cells(1, 9).Value = "Номер ТЦ"        ' 9 zwf30  
res.Cells(1, 10).Value = "К-во заказ."    ' 10 zwf30  
res.Cells(1, 11).Value = "К-во факт."     ' 11  
 
' Для zdlbestell  
 
Do  
' Fill data  
   resX = resX + 1  
   k = lstX  
   'res.Cells(resX, 1) = Sheet1.Cells(lstX + 5, 10)  
   res.Cells(resX, 2) = Sheet1.Cells(lstX + 3, 10)  
   res.Cells(resX, 2).NumberFormat = "m/d/yyyy"  
   'res.Cells(resX, 5) = Sheet1.Cells(lstX + 11, 4)  
   res.Cells(resX, 7) = Sheet1.Cells(lstX + 11, 9)  
   res.Cells(resX, 4) = Sheet1.Cells(lstX + 4, 19)  
   res.Cells(resX, 3) = Sheet1.Cells(lstX + 3, 19)  
   'res.Cells(resX, 9) = Sheet1.Cells(lstX + 11, 25)  
   res.Cells(resX, 8) = Sheet1.Cells(lstX + 11, 16)  
   'res.Cells(resX, 10) = Sheet1.Cells(lstX + 11, 20)  
   res.Cells(resX, 11) = Sheet1.Cells(lstX + 11, 20)  
   'res.Cells(resX, 1).NumberFormat = "0"  
   res.Cells(resX, 3).NumberFormat = "0"  
   'res.Cells(resX, 5).NumberFormat = "0"  
   res.Cells(resX, 6).NumberFormat = "0"  
   'res.Cells(resX, 9).NumberFormat = "0"  
   res.Cells(resX, 8).NumberFormat = "0"  
   'res.Cells(resX, 10).NumberFormat = "0"  
   res.Cells(resX, 11).NumberFormat = "0"  
     
' Check extra pos  
   Do While Sheet1.Cells(lstX + 14, 4) <> ""  
       lstX = lstX + 3  
       resX = resX + 1  
       'res.Cells(resX, 1) = res.Cells(resX - 1, 1)  
       res.Cells(resX, 2) = res.Cells(resX - 1, 2)  
       res.Cells(resX, 2).NumberFormat = "m/d/yyyy"  
       'res.Cells(resX, 5) = Sheet1.Cells(lstX + 11, 4)  
       res.Cells(resX, 7) = Sheet1.Cells(lstX + 11, 9)  
       res.Cells(resX, 4) = Sheet1.Cells(k + 4, 19)  
       res.Cells(resX, 3) = Sheet1.Cells(k + 3, 19)  
       'res.Cells(resX, 9) = Sheet1.Cells(lstX + 11, 25)  
       res.Cells(resX, 8) = Sheet1.Cells(lstX + 11, 16)  
       'res.Cells(resX, 10) = Sheet1.Cells(lstX + 11, 20)  
       'res.Cells(resX, 1).NumberFormat = "0"  
       res.Cells(resX, 3).NumberFormat = "0"  
      ' res.Cells(resX, 5).NumberFormat = "0"  
       res.Cells(resX, 6).NumberFormat = "0"  
      ' res.Cells(resX, 9).NumberFormat = "0"  
       res.Cells(resX, 8).NumberFormat = "0"  
      ' res.Cells(resX, 10).NumberFormat = "0"  
       res.Cells(resX, 11).NumberFormat = "0"  
   Loop  
' Skip to next row  
lstX = lstX + 16  
Loop While Sheet1.Cells(lstX, 11) = "Orders per supplier"  
 
 
' Удаление опорных ячеек для zdlbestell  
   Sheet1.Activate  
   Range("A2:C2").Select  
   Range("C2").Activate  
   Selection.ClearContents  
   Range("A1").Select  
   Range("A:A").Select  
   Selection.ClearContents  
     
' Часть 2  
 
   
' Разметка таблицы  
 
 
 
   resX = 1  
   lstX = 3  
 
' Основной блок  
 
Do  
 
   k1 = Sheet2.Cells(lstX, 5)  
   k2 = Sheet2.Cells(lstX, 8)  
 
     
' Проверка следующих строк  
   Do While Sheet2.Cells(lstX + 1, 4) = "2"  
       resX = resX + 1  
       lstX = lstX + 1  
         
       res.Cells(resX, 1) = k1  
       res.Cells(resX, 5) = k2  
       res.Cells(resX, 9) = Sheet2.Cells(lstX, 32)  
       res.Cells(resX, 10) = Sheet2.Cells(lstX, 7)  
         
     
       res.Cells(resX, 1).NumberFormat = "0"  
       res.Cells(resX, 5).NumberFormat = "0"  
       res.Cells(resX, 9).NumberFormat = "0"  
       res.Cells(resX, 10).NumberFormat = "General"  
         
     
   Loop  
   lstX = lstX + 1  
     
' Повтор цикла до окончания файла  
 
Loop While Sheet2.Cells(lstX, 5) <> Empty  
 
 ' Замена точки (дробного разделителя) на запятую  
     
With ActiveSheet.Range("D:D")  
   .NumberFormat = "General"  
   .Replace What:=",", Replacement:="", LookAt:=xlPart  
   .Replace What:=".", Replacement:=",", LookAt:=xlPart  
End With  
res.Cells(1, 10).Value = "К-во заказ."    ' 10 zwf30  
 
' Бантики  
 
Worksheets.Select  
Columns("A:A").ColumnWidth = 10.29  
Columns("b:b").ColumnWidth = 10.29  
Columns("c:c").ColumnWidth = 11.43  
Columns("d:d").ColumnWidth = 10.29  
Columns("E:E").ColumnWidth = 14.71  
Columns("f:f").ColumnWidth = 16.29  
Columns("g:g").ColumnWidth = 46.86  
Columns("h:h").ColumnWidth = 11.14  
Columns("i:i").ColumnWidth = 8#  
Columns("j:j").ColumnWidth = 7.29  
Columns("k:k").ColumnWidth = 8.43  
Rows("1:1").RowHeight = 29#  
 
ActiveSheet.Rows("1:1").WrapText = True  
 
ActiveSheet.Range("C:C").HorizontalAlignment = xlCenter  
 
   ActiveSheet.Select  
   Range(Selection, Selection.End(xlToRight)).Select  
       With Selection  
       .HorizontalAlignment = xlGeneral  
       .VerticalAlignment = xlTop  
       .WrapText = True  
       .Orientation = 0  
       .AddIndent = False  
       .IndentLevel = 0  
       .ShrinkToFit = False  
       .ReadingOrder = xlContext  
       .MergeCells = False  
   End With  
   ActiveSheet.Select  
   Range(Selection, Selection.End(xlDown)).Select  
   Selection.Borders(xlDiagonalDown).LineStyle = xlNone  
   Selection.Borders(xlDiagonalUp).LineStyle = xlNone  
   ActiveSheet.Select  
   With Selection.Borders(xlEdgeLeft)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
   ActiveSheet.Select  
   With Selection.Borders(xlEdgeTop)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
   ActiveSheet.Select  
   With Selection.Borders(xlEdgeBottom)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
   ActiveSheet.Select  
   With Selection.Borders(xlEdgeRight)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
   ActiveSheet.Select  
   With Selection.Borders(xlInsideVertical)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
   ActiveSheet.Select  
   With Selection.Borders(xlInsideHorizontal)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
     
ActiveSheet.Select  
ActiveSheet.Range("A1:K1").Select  
   Selection.Font.Bold = True  
     
Worksheets.Select  
ActiveSheet.Range("A1").Activate  
 
MsgBox ("Данные для Пре-Пикинг листа сформированы")  
 
End Sub  
 
 
Вот текст макроса. И правила я читал.

Вопрос. После выполнения макроса, листы почему то группируются. Как принудительно "разгруппировывать" листы?  
Спасибо.

{quote}{login=misha.name}{date=19.05.2011 04:28}{thema=Макрос для выделения таблицы}{post}Подскажите, пожалуйста, макрос, который будет выделять таблицу так, как если бы я нажал ctrl+A. Пробовал через запись макроса, но получается, если я потом добавлю в таблицу столбцы и строки и запущу этот макрос, то они уже не выделеяются. Спасибо!{/post}{/quote}  
 
   ActiveSheet.Select  
   Range(Selection, Selection.End(xlToRight)).Select  
   Range(Selection, Selection.End(xlDown)).Select  
 
Выделяет все заполненые ячейки ко правой и нижней границы листа, начиная с А1 на активном листе.

{quote}{login=The_Prist}{date=19.05.2011 03:43}{thema=Re: }{post}{quote}{login=Shaitan}{date=19.05.2011 03:42}{thema=}{post}т.е. банально что навоял, сохранять в отдельную книгу и выводить кнопки на панель инструментов?{/post}{/quote}я не знаю. Если есть что выводить и знаете как - выводите. А при другом раскладе всегда можно вызвать макрос по Alt+F8{/post}{/quote}  
Значит приедтся по старинке. Все равно спасибо за ответы.

т.е. банально что навоял, сохранять в отдельную книгу и выводить кнопки на панель инструментов?

Хотелось бы узнать, есть ли возможность сделать макросы доступные во всем экселе, а не только в той книге в которой он написан?  
Заранее спасибо.

Промахнулся с форматом архива.

Извиняюсь за большой файл. Вот новый, маленького размера.

1. Нужно создать 1 таблицу (Sheet4) из двух других (Sheet1 и Sheet2), которые в свою очередь составляются из zdlbestell и zwf30 соответственно.  
2. Так же нужно сделать разметку как в Sheet4, но без выделения цветов.  
 
Колонки, которые нужно брать из zwf30, выделены желтым  
Колонки, которые нужно брать из zdlbestell, выделены зеленым.  
 
По отдельности макросы zdlbestell и zwf30 работают и составляют Sheet1 и Sheet2 как надо. Но как сделать чтобы они сразу составляли Sheet4 как надо, а не создавали 2 отдельных листа из которого нужно будет собрать третий, общий? Или как сделать создание одного листа готового (Sheet4 который) одним макросом, чтобы он собирал все данные из zdlbestell и zwf30?    
Помогите, пожадуйста.  
<EM><STRONG>Файл удален</STRONG> - велик размер - [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>

{quote}{login=king}{date=18.05.2011 01:52}{thema=Re: Точки и запятые}{post}{quote}  
 
А не проще воспользоваться возможностью "Найти и Заменить".  
1) Заменить запятые на "пусто"  
2) Заменить точки на запятые{/post}{/quote}  
 
Этот макрос делается для тех, кто не разбирается в екселе.  
 
П.с. Спасибо KukLP. Тормознул что созданный лист становится активным. Все заработало.

Такая дилема. Имеется колонка (числовые значения и название колонки) в которой есть и точки и запятые.  
Необходимо удалить сначала все запятые (как разделители тысяч), затем заменить точки (как разделители дробных частей) на запятые.  
Имеется кусок макроса отвечающий за это:  
 
Так вот. Проблема в том, что каждый раз при запуске макроса (при его работе создается новый лист), активным листом является то 4, то 5 лист. Как решить эту проблему с постоянно меняющимся номером листа?