Имя исходного листа, введенного пользователем, скопировать данные из исходного листа, вставить в целевой лист - PullRequest
0 голосов
/ 12 января 2020

Уважаемые эксперты stackoverflow,

Я новичок в vba и хотел бы простой макрос для некоторых задач копирования и вставки. У меня есть файл xlsm, содержащий несколько рабочих листов, назовите его следующим образом. РАСЧЕТЫ LEMON ORANGE BANANA

Я знаю только очень простой и популярный макрос для мирян.

Sub copyandpasterawdata()

  Workbooks("trymacro.xlsm").Worksheets("ORANGE").Range("A1:H2000").Copy

  Workbooks("trymacro.xlsm").Worksheets("CALCULATIONS").Range("A1").PasteSpecial Paste:=xlPasteValues

End Sub

Я хотел бы сделать Имя исходного листа "Dynami c". То есть, когда я ввожу «ORANGE» в ячейку I1 на РАСЧЕТАХ рабочего листа и запускаю макрос, данные из листа ORANGE вставляются с копированием n, а когда я вводю «ЛИМОН» в ячейку I1 на РАСЧЕТАХ рабочего листа и запускаю макрос, данные вместо этого LEMON будет скопирован без вставки.

Спасибо.

Джон

1 Ответ

0 голосов
/ 12 января 2020

Поскольку вы хотите копировать только значения, вы можете использовать Range.value2 = RangeCopy.value2

Обратите внимание, что I1 находится в области вставки ваших данных, давайте попробуем:

 Option Compare Text
 Sub copyandpasterawdata()
        If ActiveSheet.Name <> "CALCULATIONS" Or Not (ThisWorkbook.Name Like "*trymacro*") Then Exit Sub

        ''check if sheetname
        'Dim sheetsname As Variant
        ' sheetsname = Array("LEMON", "ORANGE", "BANANA")
        'If IsEmpty(Filter(sheetsname, [I1].Value2, True, vbTextCompare)) Then Exit Sub
        '---------------------------------------
        Dim ws As Worksheet
        Dim isSheetname As Boolean
        For Each ws In Worksheets
            If [I1].Value2 Like ws.Name Then
                isSheetname = True
                Exit For
            End If
        Next ws
        If Not (isSheetname) Then Exit Sub

       'assign value
        Range("A1:H2000").Value = Worksheets([I1].Value2).Range("A1:H2000").Value
    End Sub

Вот более короткий код:

 Sub copyandpasterawdata()
        If ActiveSheet.Name <> "CALCULATIONS" Or Not (ThisWorkbook.Name Like "*trymacro*") Then Exit Sub
 On Error Resume Next
       ' assign value
        Range("A1:H2000").Value = Worksheets([I1].Value2).Range("A1:H2000").Value
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...