powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / ю Срочно нужна помощь в указании диапазона
10 сообщений из 10, страница 1 из 1
ю Срочно нужна помощь в указании диапазона
    #36528634
Юрий08
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Господа, срочно нужна ваша помощь.

Пытаюсь задать диапазон для копирования - OriWB.Worksheets(1).Range("A2:K2").Select

Но нихера не получается, видимо, потомучто Dim OriWB As Workbook

Как выделить и скопировать диапазон A2:K2 ?

На всякий случай вот весь макрос

Sub SborkaListov()

Dim WBmacros As Workbook 'Ôàéë äëÿ âñòàâêè äàííûõ (ôàéë ñ ýòèì ìàêðîñîì)
Dim OriWB As Workbook 'îðèãèíàëüíûé ôàéë
Dim iTempFileName As String 'èìÿ ïîî÷åð¸äíî îòêðûâàåìîãî ôàéëà

With Application
.ScreenUpdating = False
.DisplayAlerts = False
Set WBmacros = ThisWorkbook

Const DirLoc As String = "C:\Îáðàáîòêà ôèëèàëîâ ÑÈÀ\"
iTempFileName = Dir(DirLoc & "*.xls")

Do While iTempFileName <> ""

Set OriWB = Workbooks.Open(Filename:=DirLoc & iTempFileName, ReadOnly:=True)

OriWB.Worksheets(1).Range("A2:K2").Select
Selection.Copy

WBmacros.Activate

With ActiveSheet
.UsedRange.Select
.Cells(.UsedRange.Rows.Count + .UsedRange.Row, 1).Select

End With

ActiveSheet.Paste



OriWB.Close saveChanges:=False


iTempFileName = Dir

Loop

.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub
...
Рейтинг: 0 / 0
ю Срочно нужна помощь в указании диапазона
    #36528691
Djon Player
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Юрий08,

Попробуйте так:
Код: plaintext
1.
2.
OriWB.Activate
Worksheets( 1 ).Select
Range("A2:K2").Select
...
Рейтинг: 0 / 0
ю Срочно нужна помощь в указании диапазона
    #36528827
Юрий08
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
После добавления
OriWB.Activate
Worksheets(1).Select
Range("A2:K2").Select
Selection.Copy
Макрос перестал переберать все листы в книге. В чем причина?
...
Рейтинг: 0 / 0
ю Срочно нужна помощь в указании диапазона
    #36528845
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Юрий08, что-то я не вижу, где он листы перебирал. Файлы перебирает, но листы?

Я бы избавился от select:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Do While iTempFileName <> ""

Set OriWB = Workbooks.Open(Filename:=DirLoc & iTempFileName, ReadOnly:=True)

OriWB.Worksheets( 1 ).Range("A2:K2").Copy WBmacros.Sheets( 1 ).Cells(WBmacros.Sheets( 1 ).UsedRange.Rows.Count + WBmacros.Sheets( 1 ).UsedRange.Row,  1 )

OriWB.Close saveChanges:=False

iTempFileName = Dir

Loop
Проверить не могу - примера нет, свой ваять лениво...
...
Рейтинг: 0 / 0
ю Срочно нужна помощь в указании диапазона
    #36528882
Djon Player
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я так понял макрос из какого-то каталога последовательно открывает все файлы с расширением ".xls" и оттуда копирует некий диапазон на некоторый лист файла из которого запущен макрос.

Меня смущает код
Код: plaintext
1.
2.
3.
4.
5.
6.
WBmacros.Activate
With ActiveSheet
  .UsedRange.Select
  .Cells(.UsedRange.Rows.Count + .UsedRange.Row,  1 ).Select
End With

ActiveSheet.Paste
в особенности .UsedRange.Row
Что-то в нём не так.
...
Рейтинг: 0 / 0
ю Срочно нужна помощь в указании диапазона
    #36528897
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Djon Player, да нет, чуток лишнее только:
Код: plaintext
1.
2.
3.
4.
5.
Sub tt()
With ActiveSheet
  .Cells(.UsedRange.Rows.Count + .UsedRange.Row,  1 ).Select
End With
End Sub
нормально работает, только в этом (выше) коде селект совсем не обязателен.
...
Рейтинг: 0 / 0
ю Срочно нужна помощь в указании диапазона
    #36528908
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Хотя ещё немного лишнее осталось:
Код: plaintext
1.
2.
3.
4.
5.
Sub tt()
With ActiveSheet
  .Cells(.UsedRange.Rows.Count +  1 ,  1 ).Select
End With
End Sub
результат не изменился.
...
Рейтинг: 0 / 0
ю Срочно нужна помощь в указании диапазона
    #36528940
Djon Player
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Hugo121,

Вот и я о том-же, что код .UsedRange.Row при любом раскладе всегда будет возвращать цифру 1 и проще просто поставить цифру 1.
...
Рейтинг: 0 / 0
ю Срочно нужна помощь в указании диапазона
    #36529163
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Не, надо вообще отказаться от копи-пасты.
Проще же иметь счетчик строк и копию одной командой...
Код: plaintext
1.
2.
3.
4.
5.
6.
...
Set WBmacrosSheet = ThisWorkbook.ActiveSheet
nRow = ActiveSheet.Cells.UsedRange.Rows.Count+ 1 
....
OriWB.Sheets( 1 ).Range("A2:K2").Copy Dest:=WBMacrosSheet.Rows(nRow)
nRow = nRow+ 1 
...
...
Рейтинг: 0 / 0
ю Срочно нужна помощь в указании диапазона
    #36529183
Юрий08
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Заработало.

Всем спасибо!
...
Рейтинг: 0 / 0
10 сообщений из 10, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / ю Срочно нужна помощь в указании диапазона
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]