Макрос: переход на другой лист по условию

Пользователь

Сообщений: 25 Регистрация: 30.09.2017

14.11.2020 01:05:54

Здравствуйте, Подскажите как в макросе прописать переход на другой лист по условию. Знания языка скудные.

Описание: В книге 3 листа "DATALIST", "DATA", "DATABASE". Макрос запускается на листе "DATA" и распределяет значения на листе "DATABASE" по окончании работы макроса, происходит переход на лист "DATALIST".

Нужно: чтобы по окончании работы макрос осуществлял переход на другой лист по условию.

Условие: Если значение в ячейке "AY1" на листе "DATABASE" больше 2 ("AY1">2), то осуществлялся переход на лист "DATABASE", если меньше или ровно 2 ("AY1"<=2), то осуществлялся переход на лист "DATALIST".

Вот собственно сам макрос"

Код

Sub ToDATABASE()
Dim q1 As Integer
   q1 = Worksheets("DATABASE").Range("E" & Cells.Rows.Count).End(xlUp).Row + 1
    
   Worksheets("DATABASE").Range("A" & q1) = Worksheets("DATA").Range("L3")
   Worksheets("DATABASE").Range("B" & q1) = Worksheets("DATA").Range("C3")
   Worksheets("DATABASE").Range("C" & q1) = Worksheets("DATA").Range("C4")
   Worksheets("DATABASE").Range("D" & q1) = Worksheets("DATA").Range("O3")
   Worksheets("DATABASE").Range("E" & q1) = Worksheets("DATA").Range("C7")
   Worksheets("DATABASE").Range("F" & q1) = Worksheets("DATA").Range("D7")
   Worksheets("DATABASE").Range("G" & q1) = Worksheets("DATA").Range("E7")
   Worksheets("DATABASE").Range("H" & q1) = Worksheets("DATA").Range("F7")
   Worksheets("DATABASE").Range("I" & q1) = Worksheets("DATA").Range("G7")
   Worksheets("DATABASE").Range("J" & q1) = Worksheets("DATA").Range("H7")
   Worksheets("DATABASE").Range("K" & q1) = Worksheets("DATA").Range("I7")
   Worksheets("DATABASE").Range("L" & q1) = Worksheets("DATA").Range("J7")
   Worksheets("DATABASE").Range("M" & q1) = Worksheets("DATA").Range("K7")
   Worksheets("DATABASE").Range("N" & q1) = Worksheets("DATA").Range("L7")
   Worksheets("DATABASE").Range("O" & q1) = Worksheets("DATA").Range("M7")
   Worksheets("DATABASE").Range("P" & q1) = Worksheets("DATA").Range("N7")
   Worksheets("DATABASE").Range("Q" & q1) = Worksheets("DATA").Range("O7")
   Worksheets("DATABASE").Range("T" & q1) = Worksheets("DATA").Range("L4")
   Worksheets("DATABASE").Range("U" & q1) = Worksheets("DATA").Range("M4")
   Worksheets("DATABASE").Range("V" & q1) = Worksheets("DATA").Range("N4")
   Worksheets("DATABASE").Range("W" & q1) = Worksheets("DATA").Range("C5")
   Worksheets("DATABASE").Range("X" & q1) = Worksheets("DATA").Range("D5")
   Worksheets("DATABASE").Range("Y" & q1) = Worksheets("DATA").Range("E5")
   Worksheets("DATABASE").Range("AG1") = Worksheets("DATA").Range("C5")
   Worksheets("DATABASE").Range("AH1") = Worksheets("DATA").Range("D5")
   
   
   Sheets("DATALIST").Select
    Application.ScreenUpdating = True
       
   
    
    
End Sub

vikttur

Пользователь

Сообщений: 47199 Регистрация: 15.09.2012

14.11.2020 01:17:27

Код
If Worksheets("DATABASE").Range("AY1")> Then Worksheets("DATABASE").Activate Else Worksheets("DATALIST").Activate End If

Ваш макрос, немного измененный:

Код

Sub ToDATABASE()
    Dim oSht As Worksheet
    Dim aColumn(), aAddr()
    Dim q1 As Long, j As Long
    
    aColumn = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10) ' дополнить номерами столбцов (всего 23)
    aAddr = Array("L3", "C3", "C4", "O3", "C7", "D7", "E7", "F7", "G7", "H7") ' дополнить адресами (всего 23)
    Set oSht = Worksheets("DATA")
    
    With Worksheets("DATABASE")
        q1 = .Cells(.Rows.Count, 5).End(xlUp).Row + 1
        
        For j = 0 To UBound(aColumn)
            .Range(q1, aColumn(j)).Value = oSht.Range(aAddr(j)).Value
        Next j
        
        .Range("AG1:AH1").Value = oSht.Range("C5:D5").Value
    End With
    
    Set oSht = Nothing
    
    'переход на другой лист по условию
End Sub

Puhlyi Пользователь Сообщений: 25 Регистрация: 30.09.2017	#3 14.11.2020 02:18:40 Огромадное СПАСИБО!!!