Копирование из одной таблицы и вставка в другую

[Smaragdov]

Спасибо, Hugo121! Буду дальше экспериментировать...


Из таблицы "СПИСОК" у меня также формируется накладная для печати по всем записям (кроме первой строки с заголовками колонок).
Вначале добавляю в бланк накладной строки, путем копирования строки-образца и вставки, затем в этих добавленных строках заполняю значениями ячейки:
Worksheets("ПЕЧАТЬ").Cells(curR, curC).Value = Str
Где: curR – текущая строка, curC – текущая колонка, Str – добавляемая строка
При этом постоянно повторяется Worksheets("ПЕЧАТЬ")

Конструкция такого вида:

        Dim page as Worksheet
        page = Worksheets("ПЕЧАТЬ")	' тут вылетает ошибка
        page.Cells(curR, curC).Value = Str

почему-то не работает, вылетает ошибка

В чем тут ошибка? Что я неправильно объявляю или присваиваю?

[Hugo121]

set page = Worksheets("ПЕЧАТЬ")
это ведь объект.

[EducatedFool]

Smaragdov, совет на будущее: старайтесь не использовать в качестве имён переменных названия классов (типа page) и названия встроенных в VBA функций (типа Str)
Не факт, что из-за этого программа работать не будет,
но порой могут возникать сложновыявляемые ошибки.

Те же имена переменных замените на MyPage и txt - и проблем с кодом точно не будет.

PS: Если лист "ПЕЧАТЬ" находится в том же файле, что и код, можно поступить проще (я всегда так делаю)
В редакторе VBA измените кодовое имя листа ПЕЧАТЬ (свойство Name в окне свойств) - поставьте туда, например, shPRINT

И потом из кода обращайтесь по этому кодовому имени:
shPRINT.Cells(curR, curC).Value = txt

В этом случае строк типа Dim shPRINT as Worksheet: shPRINT = Worksheets("ПЕЧАТЬ") не потребуется,
да и вы в любой момент можете переименовать лист (то, что отображается на ярлычке листа) - на работоспособность кода это не повлият, поскольку кодовое имя листа останется тем же.

[Smaragdov]

Еще раз спасибо, Hugo121!
Теперь буду знать, как присваиваются значения объектам на VBA!
Начал решать подобные задачи недавно, все еще малопонятно... К сожалению, никак не могу найти хорошего справочника по VBA, а синтаксис тут весьма экзотический (для меня)... :-)

Времени на обстоятельное изучения языка нет (полно иных обязанностей), а начальство торопит с результатами...


Уважаемый EducatedFool, спасибо за советы!
Очень любопытный способ создания псевдонимов имен таблиц – буду использовать!


Сейчас пытаюсь разобраться с тем, как помечать строки в Базе (с сохранением выделения при закрытии файла) и копировании оных в СПИСОК текущего дня.
Пока что ничего, кроме выделения цветом первой ячейки, и поиска по цвету фона, не могу придумать...

В код таблицы "БАЗА" добавил процедуру, меняющую фоновый цвет ячейки с красного на белый, и обратно по двойному клику в первой ячейке выделяемой строки (код частично позаимствован с этого форума):

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column <> 1 Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If ActiveCell.Interior.ColorIndex <> 3 Then
        ActiveCell.Interior.ColorIndex = 3
    Else
        ActiveCell.Interior.ColorIndex = 2
    End If
    ActiveCell.Borders.ColorIndex = 1

Cancel = True
End Sub

А в модуль книги добавляю такую процедуру:

Public Sub CopyToList()     ' Копирование выделенных строк из "БАЗА" в "СПИСОК"
    Dim i As Integer, maxRowSrc As Integer, maxRowTrg As Integer

    Sheets("БАЗА").Activate     ' открываем таблицу "БАЗА"

    maxRowSrc = GetMaxRow("БАЗА")   ' сколько всего строк в БАЗЕ

    For i = 1 To maxRowSrc    ' просматриваем все записи в таблице "БАЗА"
        If Cells(i, 1).Interior.ColorIndex = 3 Then     ' если фон в первой ячейке строки - красный
            maxRowTrg = GetMaxRow("СПИСОК")     ' определяем кол-во строк в СПИСКЕ
            Cells(i, 1).Interior.ColorIndex = 2         ' устанавливаем цвет фона ячейки - белый
            Rows(i).Copy Sheets("СПИСОК").Rows(maxRowTrg + 1)   ' копируем строку из "БАЗА" в "СПИСОК"
            Sheets("СПИСОК").Cells(maxRowTrg + 1, 1).NumberFormat = "General"   ' устанавливаем формат ячейки, как "общий"
            Sheets("СПИСОК").Cells(maxRowTrg + 1, 1).FormulaR1C1 = "=ROW()-1"   ' формула, задающая номер записи в текущем СПИСКЕ
        End If
    Next i
End Sub

Пожалуйста покритикуйте, что тут неграмотно.

[Vasiliy_S]

Сообщение от EducatedFool

1. Снять выделение (которое после копирования) можно строкой кода
application.CutCopyMode= false

2. В вашем случае (да и вообще почти в любом коде) использование методов Select и Activate не требуется, и только усложняет код, увеличивая время выполнения макроса.


Проще и быстрее будет так:

Public Sub CopyPaste1()     ' эта функция копирует записи за сегодня и вставляет их в общую базу
    Dim maxRowSrc As Integer, maxRowTrg As Integer  ' объявление переменных

    maxRowSrc = GetMaxRow("СПИСОК")     ' определяем количество строк на листе "СПИСОК"
    maxRowTrg = GetMaxRow("БАЗА")      ' определяем количество строк на листе "БАЗА"

    ' копирование и вставка без всяких выделений - так проще и быстрее
    Worksheets("СПИСОК").Range("2:" & maxRowSrc).Copy Sheets("БАЗА").Cells(maxRowTrg + 2, 1)
End Sub

Без разницы. Я обычно использую Activate

А подскажите, пожалуйста как в такой конструкции :
Range("2:" & maxRowSrc)
указать на диапазон строчек с i-той по maxrowSrc ?

Спасибо заранее ...

[EducatedFool]

как в такой конструкции :
Range("2:" & maxRowSrc)
указать на диапазон строчек с i-той по maxrowSrc ?

Range(i & ":" & maxRowSrc)

[Vasiliy_S]

Спасибо !
а ведь очень логично !
еще раз спасибо !

[meg8639]

Добрый день,

Прошу, подскажите где ошибка в коде( или как его сделать правильным):
Sub Макрос3()
Dim WB As Workbook, Wb2 As Workbook
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim X As Range
Set WB = Workbooks("Таблица1 (1)1.xls")
Set Wb2 = Workbooks("Таблица2 (1)1.xls")
Set Sh1 = WB.Worksheets(1)
Set Sh2 = Wb2.Worksheets(1)
Dim lLastRow As Long
lLastRow = Sh1.Cells(Sh1.Rows.Count, 1).End(xlUp).Row
LastRow = lLastRow - 1
Dim rFndRng As Integer
rFndRng = ActiveSheet.UsedRange.Find("ВЗР", , xlFormulas, xlWhole)
Sh1.Range("rFndRng:B" & LastRow).Copy Sh2.Range("B2")
Set X = Sh2.Columns("B").Find(Application.M ax(Sh2.Columns("B")))
If Not X Is Nothing Then
MsgBox " Строка " & X.Row & " Значение " & X.Value
End If
End Sub

Задача: по имени первой ячейки ( ВЗР) плюс одна ячейка начать копировать меняющийся диапазон строк ( может быть от 1-й до 30)- всю строку копировать ( а не только столбец B - потому что приведённый выше код работает только с одном столбцом) и скопировать по последней ячейке относящейся только к диапазону ВЗР ( из прикреплённых файлов видно что придётся использовать lLastRow - 1- потому что Итог не нужен - а первая текстовая ячейка ( зелёная карта) - уже должна относится к другому скопированному диапазону)

Спасибо, большое если поможете разобраться