Программа Vb для копирования в Excel

[Magus]

Здравствуйте!

Помогите разобраться

Столкнулся на работе с задачей, требующей много времени. Решил автоматизировать и запутался. Суть в следующем.

Файл Excel содержит около 30 листов, из которых один рабочий- в него нужно копировать данные с остальных листов. Каждый лист содержит одну и ту же таблицу с одинаковой шапкой, находящейся в столбиках "A:K"
Каждая таблица содержит до 100 строчек (первая строчка данных каждой таблицы начинается с 3 строчки листа Excel, во второй строчке- шапка)

Пытаюсь написать программу, которая бы копировала все таблицы на первый рабочий лист в столбики "A:K", начиная с 3 строки

Вроде не сложно, а не получается, занимаюсь программиванием в Excel совсем недавно.
Начал я так

Public Sub total()

Dim ws As Worksheet
Dim number As Integer
Dim i, j As Integer

i = 3
j = 102

For Each ws In Sheets
number = number + 1
Next ws

Дальше нужно, чтобы программа проходила от листа 2 до последнего(number), а как это задать- не могу понять. Пробовал представить рабочие листы в виде массива, получилась настоящая ерунда

Конец программы как-будто понятен.

worksheets(number).Rows("3:100").copy
workSheets(1).Rows("i:j").Select
workSheets(1).Rows("i:j").Paste

i = i + 100
j = j + 100

Next number
End Sub

Заранее благодарен

 

[PlanB]

Не нужен Вам макрос. используйте стандартную функцию excel:
=ДВССЫЛ(СЦЕПИТЬ("'";$B$1;"(название листа)'!O28"))
она связана с раскрывающимся списком из названий листов. меняется он - меняются данные в шапке

 

[Vlanib]

[codebox]
Dim i As Integer, iLastRow As Integer
For i = 2 To Worksheets.Count
With Worksheets(i)
iLastRow = .UsedRange.Rows.Count
.Range(.Cells(3, 1), .Cells(iLastRow, 11)).Copy
iLastRow = (Worksheets(1).UsedRange.Rows.Count) + 3
Worksheets(1).Cells(iLastRow, 1).PasteSpecial xlPasteValues
End With
Next
[/codebox]

Ну где то так, если я правильно задачу понял.

 

[Tanya]

Vlanib прав, но есть маленькие поправки к коду:

Dim i As Integer, iLastRow As Integer
For i = 2 To Worksheets.Count
With Worksheets(i)
iLastRow = [b].UsedRange.Row + .UsedRange.Rows.Count - 1[/b]
.Range(.Cells(3, 1), .Cells(iLastRow, 11)).Copy
[b]iLastRow = (Worksheets(1).UsedRange.Row + Worksheets(1).UsedRange.Rows.Count)[/b]
Worksheets(1).Cells(iLastRow, 1).PasteSpecial xlPasteValues
End With
Next

По-крайней мере, предыдущий код на моем компе работал не совсем корректно

И есть вариант без копирования, но смысл тот же )) просто без выделения и копирования, по идее должен быстрее работать:

Sub nn()
Dim i As Integer
Dim iStart As Integer
Dim iEnd As Integer
Dim iLastRow As Integer

iEnd = 2
For i = 2 To Worksheets.Count
With Worksheets(i)
iLastRow = .UsedRange.Row + .UsedRange.Rows.Count - 1
iStart = iEnd + 1
iEnd = iEnd + iLastRow - 2
Worksheets(1).Range("A" & iStart & ":K" & iEnd).Value = .Range("A3:K" & iLastRow).Value
End With
Next i
End Sub

 

[Vlanib]

Правильно! Старая добрая песня об определении последней ячейки. Я просто исходил из предположения, что нет пустых строчек в используемых диапазонах.

 

[Magus]

Vlanib, что это за песня об определении последней ячейки? Подскажите, что вы имеете ввиду под пустыми строчками в используемых диапазонах? У меня их как-будто нет.
А программа все равно не хочет работать правильно. Не могу понять в чем дело

 

[Tanya]

Я обе проверяла вроде ..., но всегда есть шанс промахнуться )))

По шагам можно пройтись и определить на каком шаге, и что делается неправильно.

 

[Vlanib]

Перешли мне файлик. Если хочешь я гляну че к чему. Vladimir--@list.ru

 

[Magus]

Таня, обе программы работают правильно. Большое спасибо за помощь