Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Копирование строк как значения в другую книгу, ошибка при вставке строки
 
Добрый день. у меня не получилось вставить код в другом виде, если кто то покажет то буду благодарен
Проблема одна не могу вставить строку как значения.
Спасибо

Код
Sub stroki2()
    Dim Linia As String, RD As String, i As Long, kol_vo As Long, kol_vo2 As Long, x As Long, r As Long, t As Long
    If Not Range("AB24, AB26") Is Nothing Then
     x = 2
      r = 2
       
        Linia = ThisWorkbook.Sheets("АООК").Range("AB26")
        RD = ThisWorkbook.Sheets("АООК").Range("AB24")
        
        With Workbooks("Накопительная ТК.xlsm").Sheets("Сварка")
            kol_vo = .Cells(Rows.Count, 2).End(xlUp).Row
            For i = 1 To kol_vo
                If .Cells(i, 4) = Linia Then
                    If .Cells(i, 2) = RD Then
                    
                        x = x + 1

                   Rows(i).Copy ThisWorkbook.Sheets("Сварка").Cells(x, 1)
                     
                        
                    End If
                End If
            Next
        End With

    End If
    
    Application.EnableEvents = True 'а тут не помешает
End Sub
Изменено: Артур Рахматуллин - 8 апр 2021 18:34:39
 
См. картинку
Screenshot_1.png (31.8 КБ)
 
Спасибо!!!!
 
Попробуйте так

Код
Sub stroki2()
   Dim Linia As String, RD As String, i As Long, kol_vo As Long, kol_vo2 As Long, x As Long, r As Long, t As Long
   
    If Not Range("AB24, AB26") Is Nothing Then
        x = 2
        r = 2
        Linia = ThisWorkbook.Sheets("АООК").Range("AB26")
        RD = ThisWorkbook.Sheets("АООК").Range("AB24")
        With Workbooks("Накопительная ТК.xlsm").Sheets("Сварка")
            kol_vo = .Cells(Rows.Count, 2).End(xlUp).Row
            For i = 1 To kol_vo
                If .Cells(i, 4) = Linia Then
                    If .Cells(i, 2) = RD Then
                        x = x + 1
                        .Rows(i).Copy
                        ThisWorkbook.Sheets("Сварка").Cells(x, 1).PasteSpecial xlPasteValues
                    End If
                End If
            Next
         End With
    End If
End Sub
Изменено: New - 8 апр 2021 19:12:33
 
Цитата
New написал:
Попробуйте так
Спасибо!!! забыл точку поставить перед

Код
.Rows(i).Copy
ThisWorkbook.Sheets("Сварка").Cells(x, 1).PasteSpecial xlPasteValues
Страницы: 1
Читают тему (гостей: 1)
Наверх