Прокрутите столбец и скопируйте / вставьте каждое значение в другую книгу - PullRequest
0 голосов
/ 16 мая 2019

Я должен создать макрос для работы в Excel и заблудиться, и мне было интересно, может ли Yall помочь.

Итак, у меня есть две рабочие тетради.Первая рабочая книга (TEST) имеет форму, которую мне нужно распечатать, вторая рабочая книга (Coin Test) содержит необработанные данные.У меня есть ячейка в книге форм, где, если я вставлю номер элемента из книги необработанных данных, он автоматически извлечет всю информацию об элементе из таблицы необработанных данных с помощью формулы и заполнит форму (Номер элемента, Спецификации элемента,Цена товара и т. Д.).

Так что мне нужно сделать, это автоматизировать переход к необработанному листу данных, скопировать первый номер элемента из C1, а затем перейти к книге формы и вставить этот номер элемента в ячейку J2, где он будет автоматически заполнятьсяИз формы, затем распечатайте эту форму, а затем вернитесь в рабочую книгу необработанных данных и перейдите к следующему номеру элемента, промойте и повторите.Я пытался собрать воедино коды, вот мой монстр.Спасибо всем за любую помощь

Sub Macro4()

'Macro4 Macro

  Sheets("TESTING").Select
  Selection.Copy

  Sheets("COIN TESTING").Select
  ActiveSheet.Paste

  For Each Cell In Range("C$:C$")

    If Cell.Value = vbNullString Then Exit For

    Range("C$:C$").Value = Cell.Value
    Cell.Offset(1, 0).Value = Range("J2").Value

  Next

End Sub

1 Ответ

0 голосов
/ 16 мая 2019

Непроверенные:

Sub Macro4()

    Dim c As Range, rng As Range

    'get the range to loop over
    with Sheets("COIN TESTING")
        Set rng = .Range("C1:C" & .cells(.rows.count,3).end(xlUp).Row)
    end with

    'process each cell in turn
    For each c in rng.cells

        'is there a value to transfer?
        If Len(c.value) > 0 then
            'directly assign the value - no need for copy/paste
            Sheets("TESTING").Range("J2").Value = c.value

            'calculate and print out sheet
            Sheets("TESTING").UsedRange.Calculate 'refresh formulas
            Sheets("TESTING").PrintOut

        End if

    Next c

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...