Страницы: 1
RSS
Макрос копирования данных из одной таблицы в последнюю свободную строку другой
 
Здравствуйте, уважаемые знатоки. Я сделал две таблицы:
- в первой (продажи) я ввожу данные
- Вторая служит реестром
на кнопке "записать" макрос для копирования, который я никак не могу довести до ума.
Нужно, чтобы все данные из столбцов "C"- "O" таблицы "продаж" копировались в первую пустую строку (и соответствующие столбцы) таблицы "реестр продаж ".
Пока что получается, что данные копируются в ячейку С3 и при следующем выполнении макроса перезаписываются друг на друга.
Помогите пожалуйста новичку!
 
Дмитрий,
Код
Sub ÄîáàâèòüÏðîä()
Dim sh As Worksheet, sh2 As Worksheet, lr As Long, i As Long, k As Long, x As Long
Set sh = Worksheets("Ðååñòð ïðîäàæ"): Set sh2 = Worksheets("Ïðîäàæè")
Application.ScreenUpdating = False
With sh2
k = Application.WorksheetFunction.CountIf(.Columns(16), "a")
If k = 0 Then
MsgBox "Ôîðìà ââîäà íå çàïîëíåíà!", vbCritical, "Îøèáêà çàïèñè"
Exit Sub
End If
Worksheets("Ðååñòð ïðîäàæ").Unprotect Password:=""
    lr2 = .Cells(Rows.Count, 15).End(xlUp).Row
    For i = 7 To lr2
    lr = sh.Application.WorksheetFunction.Count(sh.Range("C3:C100000"))
    If lr = 0 Then lr = 3 Else lr = lr + 3
        If .Cells(i, 16) = "a" Then
            sh.Rows(lr & ":" & lr).Insert
            .Range("C" & i & ":O" & i).Copy
            sh.Cells(lr, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
    Next i
End With
sh.Activate
ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
Application.ScreenUpdating = True
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, Код работает некорректно, если ввести в наименования не цифры, а названия, то строки вставляются не по-порядку
Изменено: Дмитрий - 10.01.2022 16:49:50
 
Дмитрий, не понятно что значит не по порядку у меня по порядку - каждая  по очереди от первой к последней с первого листа и в последнюю пустую второго листа друг за другом, а что у Вас не так не знаю
Изменено: Mershik - 10.01.2022 16:53:08
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, попробуйте на листе продажи в наименовании ввести не цифры, а, например Яблоко, Банан, 1, и  нажмите "записать" несколько раз
 
Дмитрий, просто замените  
Код
lr = sh.Application.WorksheetFunction.Count(sh.Range("C3:C100000"))
на
Код
lr = sh.Application.WorksheetFunction.CountA(sh.Range("C3:C100000"))
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, спасибо огромное! очень помогли!  
 
Дмитрий, пожалуйста, еще и свой же макрос дорабатываю (думаю что-то знакоме))
Изменено: Mershik - 10.01.2022 17:22:43
Не бойтесь совершенства. Вам его не достичь.
Страницы: 1
Наверх