Макрос Excel и VBA, Копирование диапазона ячеек на другой лист (транспонированный и основанный на другом значении) - PullRequest
0 голосов
/ 30 января 2019

Я пытался откровенничать в решении из разных потоков, но я очень новичок в VBA и программировании, так что не очень хорошо ...

Вот некоторая базовая информация:

  • У меня есть 2 листа в одной книге (База данных и запись данных)
  • Они содержат одинаковые заголовки, но транспонированы (База данных имеет заголовки в столбцах, в то время как запись данных содержит их вряды)

Теперь я ищу 3 вещи (в идеале в одном компактном решении)

  1. Имею командную кнопку, которая копирует и транспонирует самый последний диапазон(крайний левый столбец) от ввода данных в базу данных.(Это делается в приведенном ниже коде)

  2. Это следует делать в зависимости от определенного значения ячейки в листе ввода данных (в идеале эта ячейка может оставаться частью скопированного диапазона, однако этоне имеет значения)

  3. Удалите исходный диапазон из таблицы ввода данных.

Как я уже говорил, я только начинаю работать с VBAтак что я совершенно не уверен, как поступить с этим, я приложил то, что я до сих пор собрал (исключая Nr.2 и чувствует себя очень громоздким в целом).Любая помощь очень ценится!

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim xSheet As Worksheet
    Set xSheet = ActiveSheet
        If xSheet.Name <> "Definitions" And xSheet.Name <> "fx" And xSheet.Name <> "Needs" Then
            xSheet.Range("E6:E200").Copy
            Worksheets("Sheet1").Range("E6:AZ6").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        End If

    Application.ScreenUpdating = True
End Sub

1 Ответ

0 голосов
/ 30 января 2019

Проверьте это.Проверяет значение E10.Если это «Y», то данные копируются и удаляются с исходного места.В противном случае он показывает сообщение пользователю.

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim xSheet As Worksheet
    Set xSheet = ActiveSheet
        If xSheet.Name <> "Definitions" And xSheet.Name <> "fx" And xSheet.Name <> "Needs" Then
            If xSheet.Range("E10")="Y"
                xSheet.Range("E6:E200").Copy
                Worksheets("Sheet1").Range("E6:AZ6").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
                xSheet.Columns("E").Delete
            Else
                MsgBox("Data entry not ready!")
            End If
        End If

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