вставка диапазона ячеек со смещением

Вход

Регистрация

Напомнить пароль

= Мир MS Excel/вставка диапазона ячеек со смещением - Мир MS Excel

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

вставка диапазона ячеек со смещением

АСЕ

Дата: Четверг, 31.01.2013, 23:14 | Сообщение № 1

Группа: Гости

Здравствуйте, помогите пожалуйста. Нужно создать макрос, который выбирал бы все листы кроме последнего, копировал диапазон ячеек одних и тех же во всех листах и вставлял их в последний лист в строчку.
[vba]

Код

Sub Макрос1()

Dim a&(), i&
ReDim a(Sheets("Лист1").Index To Sheets("Лист3").Index - 1)
For i = LBound(a) To UBound(a)
a(i) = i
Next
Sheets(a).Select

Range("B6:B11").Select
Selection.Copy
Sheets("Лист3").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub

[/vba]

[admin]Оформляйте коды тегами![/admin]

Ответить

AlexM

Дата: Пятница, 01.02.2013, 11:02 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4517

Репутация: 1129 ±

Замечаний: 0% ±

Excel 2003

Код
[vba]

Код

Sub Macros()
Dim Arr, MyArr() As Double
Dim i As Long, j As Long, n As Long
For i = 1 To Sheets.Count - 1
     Arr = Sheets(i).Range("B6:B11")
     For j = 1 To UBound(Arr)
         ReDim Preserve MyArr(1 To 1, 0 To n)
         MyArr(1, n) = Arr(j, 1): n = n + 1
     Next j
Next
Sheets(Sheets.Count).Range("A2").Resize(1, n) = MyArr 'вывод в строку
'Sheets(Sheets.Count).Range("A2").Resize(n, 1) = Application.Transpose(MyArr) 'вывод в столбец
End Sub

[/vba]

К сообщению приложен файл: ACE.xls (31.0 Kb)

Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.

Ответить

вставка диапазона ячеек со смещением

Страница 1 из 1
1