0

Есть макрос - копирует данные из донора в файл. Возможно ли сделать, чтобы данные вставлялись в первую пустую ячейку столбца B ? ну и сколько есть данных вставлялись вниз и вправо. цель - по кнопке добавлять ниже новые данные из донора.

Sub объем()

    Dim sht As Worksheet
    Dim i As Long
    With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With
    Set sht = ThisWorkbook.Sheets("Остатки")

    'Открываем другой файл'
    With Application.Workbooks.Open("C:\Users\Desktop\ppweb2.xls")
        With .Sheets("Sheet1")
            'Обрабатываем диапазон'
            For i = 3 To 200
            If .Cells(i, 3).Value = "" Then Exit For
                'значение ячейки из другого файла вставляем куда надо'
                sht.Cells(i - 2, 1).Value = .Cells(i, 1).Value
                sht.Cells(i - 2, 2).Value = .Cells(i, 2).Value
                sht.Cells(i - 2, 3).Value = .Cells(i, 3).Value
                sht.Cells(i - 2, 4).Value = .Cells(i, 4).Value
                sht.Cells(i - 2, 5).Value = .Cells(i, 5).Value
                sht.Cells(i - 2, 6).Value = .Cells(i, 6).Value
                sht.Cells(i - 2, 7).Value = .Cells(i, 7).Value
                sht.Cells(i - 2, 8).Value = .Cells(i, 8).Value
                sht.Cells(i - 2, 9).Value = .Cells(i, 9).Value
                sht.Cells(i - 2, 10).Value = .Cells(i, 10).Value
                sht.Cells(i - 2, 11).Value = .Cells(i, 11).Value
                sht.Cells(i - 2, 12).Value = .Cells(i, 12).Value
                sht.Cells(i - 2, 13).Value = .Cells(i, 13).Value
                sht.Cells(i - 2, 14).Value = .Cells(i, 14).Value
                sht.Cells(i - 2, 15).Value = .Cells(i, 15).Value
                sht.Cells(i - 2, 16).Value = .Cells(i, 16).Value
                sht.Cells(i - 2, 17).Value = .Cells(i, 17).Value
                sht.Cells(i - 2, 18).Value = .Cells(i, 18).Value
                sht.Cells(i - 2, 19).Value = .Cells(i, 19).Value
                
            Next i
        End With

        .Close
    End With

    With Application: .ScreenUpdating = True: .DisplayAlerts = True: End With
    Set sht = Nothing

End Sub

5
  • в первую пустую ячейку столбца B ? Range("B:B").End(xlDown).Offset(1,0).Address. 'значение ячейки из другого файла вставляем куда надо' А про существование Range.Copy Вы типа не в курсе?
    – Akina
    Commented 2 апр. 2019 в 12:56
  • @Akina не понял, в какую часть добавить надо Range("B:B").End(xlDown).Offset(1,0).Address ? нет, не в курсе, лишь месяц пытаюсь писать макросы, а знаний никаких)
    – skawn
    Commented 8 апр. 2019 в 11:59
  • в какую часть добавить надо Я почём знаю, куда Вам что добавить надо? Это выражение даст первую пустую ячейку (вернее, её адрес) после последней заполненной ячейки в колонке B. Что позволит избавиться от цикла поиска.
    – Akina
    Commented 8 апр. 2019 в 12:03
  • @Akina я предположил, что в выражение вставки скопированного на текущий лист - sht.Cells(i - 2, 2).Value = .Cells(i, 1).Value, вместо "i - 2", но получил ошибку 13
    – skawn
    Commented 8 апр. 2019 в 12:11
  • насколько понял нужно задать переменную куда поместить адрес этой пустой ячейки и потом использовать его вместо i, но что-то не выходит :\
    – skawn
    Commented 8 апр. 2019 в 12:20

2 ответа 2

1
Sub MyCopy()
    Dim wbksrc As Workbook
    Dim wbkdst As Workbook
    Dim shtsrc As Worksheet
    Dim shtdst As Worksheet

    Set wbksrc = Workbooks.Open("C:\Users\Desktop\ppweb2.xls")
    Set wbkdst = ThisWorkbook
    Set shtsrc = wbksrc.Sheets("Sheet1")
    Set shtdst = wbkdst.Sheets("Остатки")

    Application.CutCopyMode = False

    ' Откорректировать диапазон-источник '
    shtsrc.Range("B1:B19").Copy 
    ' Откорректировать диапазон-приёмник '
    shtdst.Paste Destination:=shtdst.Range("B:B").End(xlDown).Offset(1,0)

    wbksrc.Close savechanges:=False
End Sub
2
  • спасибо, но диапазон не хотелось бы использовать, так как источник пополняется и когда-то источник станет шире чем диапазон. Или как-то можно указать, чтобы забирались все значения начиная с А5 и заканчивая последним значением столбца R?
    – skawn
    Commented 9 апр. 2019 в 10:33
  • 1
    @Степан диапазон не хотелось бы использовать, так как источник пополняется и когда-то источник станет шире чем диапазон. Вот этой фразы не понял от слова "совсем". Не привязывайся ты к тому, что у меня указан статический адрес диапазона =- это я на твой же собственный код ориентируюсь. Никто не мешает тебе программно определить реальный размер источника, тем же Range.End с соответствующим параметром.
    – Akina
    Commented 9 апр. 2019 в 10:44
0
Sub Volume2()
    Dim rRng As Range
    Dim lRw As Long
    Const lClmn As Long = 19

    With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With

    With Application.Workbooks.Open("D:\ppweb2.xlsx")
        With .Sheets("Sheet1")
            lRw = .Cells(.Rows.Count, "A").End(xlUp).Row - 2

            If lRw > 0 Then
                Set rRng = .Range("A3").Resize(lRw, lClmn)

                With ThisWorkbook.Sheets("Остатки")
                    lRw = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
                    .Cells(lRw, 2).Resize(rRng.Rows.Count, lClmn).Value = rRng.Value
                End With
            End If
        End With

        .Close
    End With

    With Application: .ScreenUpdating = True: .DisplayAlerts = True: End With
    Set rRng = Nothing
    MsgBox "OK", 64,""
End Sub

Ваш ответ

Нажимая «Отправить ответ», вы соглашаетесь с условиями пользования и подтверждаете, что прочитали политику конфиденциальности.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.