Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 13 След.
Фиксация значения в ячейке после изменения значения в другой ячейке
 
Код
Sub Copy_value()
   
    my_row = ActiveCell.Row
    my_col = (Cells(my_row, 100).End(xlToLeft).Column) + 1
    current_value = Cells(my_row, 4).Value
    If my_col < 9 Then
        my_col = 9
    End If
    Cells(my_row, my_col).Value = current_value
    
End Sub


Изменено: PDO - 17.07.2020 22:16:12
Публикация книги в формате Web-страницы
VBA. Перенос значений в столбце из первого листа по одной ячейке на новые листы.
 
Код
Sub Slect_range()

    lastColumn = Sheets(1).Cells(1, 100).End(xlToLeft).Column
    lastRow = Sheets(1).Cells(1000, 1).End(xlUp).Row
    Call Add_sheets(lastColumn, lastRow)

End Sub

Sub Add_sheets(col, rows)
    
        For mRow = 1 To rows
            cell_value = Sheets("Лист1").Cells(mRow, col).Value
            sheet_name = Str(mRow) & "_" & cell_value
            On Error Resume Next
                cheker = Sheets(sheet_name).Name
                If cheker = sheet_name Then
                    Sheets(sheet_name).Cells(1, 1).Value = cell_value
                    GoTo next_row
                Else
                    Sheets.Add(After:=Sheets(Sheets.Count)).Name = sheet_name
                    Sheets(sheet_name).Cells(1, 1).Value = cell_value
                End If
next_row:
        Next mRow
    
End Sub
 


Если лист с  именем "Номер_Название" есть, то в "А1"  добавляется содержимое с Листа1.
Если листа с именем "Номер_Название" нет, то создается такой лист и в "А1" добавляется содержимое с Листа1.
Изменено: PDO - 17.07.2020 13:09:36
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 13 След.
Наверх