Доброго времени суток! Помогите пжл, нужен макрос по истории нажатий, при нажатии на кнопку нужно сохранять определенные данные с листа и располагать их вниз в таблице описание в файле заранее очень благодарен
Доброго времени суток! Помогите пжл, нужен макрос по истории нажатий, при нажатии на кнопку нужно сохранять определенные данные с листа и располагать их вниз в таблице описание в файле заранее очень благодаренXenus91
Sub Кнопка1_Щелчок() Application.ScreenUpdating = False u = Cells(Rows.Count, "h").End(xlUp).Row f = Application.CountIf(Range("h2:h" & u), Range("n1")) g = 2 For i = 1 To f s = Application.Match(Range("n1"), Range("h" & g & ":h" & u), 0) g = g + s y = Cells(Rows.Count, "t").End(xlUp).Row + 1 Range("a" & g - 1 & ":h" & g - 1).Copy Range("t" & y) Next Application.ScreenUpdating = True End Sub
[/vba]
[vba]
Код
Sub Кнопка1_Щелчок() Application.ScreenUpdating = False u = Cells(Rows.Count, "h").End(xlUp).Row f = Application.CountIf(Range("h2:h" & u), Range("n1")) g = 2 For i = 1 To f s = Application.Match(Range("n1"), Range("h" & g & ":h" & u), 0) g = g + s y = Cells(Rows.Count, "t").End(xlUp).Row + 1 Range("a" & g - 1 & ":h" & g - 1).Copy Range("t" & y) Next Application.ScreenUpdating = True End Sub
Nic70y, большое спасибо! проверил, не вставляет данные из фикс ячеек K4,K5,K6 в столбцы R,Q,S возможно исправить? и что нужно изменить если массив для поиска h2:h находится на другом листе и строки для копирования на этом же листе пример приложил заранее огромное спасибо
Nic70y, большое спасибо! проверил, не вставляет данные из фикс ячеек K4,K5,K6 в столбцы R,Q,S возможно исправить? и что нужно изменить если массив для поиска h2:h находится на другом листе и строки для копирования на этом же листе пример приложил заранее огромное спасибоXenus91
Sub Кнопка1_Щелчок() Application.ScreenUpdating = False u = Sheets("Лист2").Cells(Rows.Count, "h").End(xlUp).Row f = Application.CountIf(Sheets("Лист2").Range("h2:h" & u), Range("n1")) g = 2 For i = 1 To f s = Application.Match(Range("n1"), Sheets("Лист2").Range("h" & g & ":h" & u), 0) g = g + s y = Cells(Rows.Count, "t").End(xlUp).Row + 1 Sheets("Лист2").Range("a" & g - 1 & ":h" & g - 1).Copy Range("t" & y) Next a = Cells(Rows.Count, "q").End(xlUp).Row + 1 b = Cells(Rows.Count, "t").End(xlUp).Row Range("q" & a & ":q" & b) = Range("k5").Value Range("r" & a & ":r" & b) = Range("k4").Value Range("s" & a & ":s" & b) = Range("k6").Value Application.ScreenUpdating = True End Sub
[/vba]
не дочитал, держите [vba]
Код
Sub Кнопка1_Щелчок() Application.ScreenUpdating = False u = Sheets("Лист2").Cells(Rows.Count, "h").End(xlUp).Row f = Application.CountIf(Sheets("Лист2").Range("h2:h" & u), Range("n1")) g = 2 For i = 1 To f s = Application.Match(Range("n1"), Sheets("Лист2").Range("h" & g & ":h" & u), 0) g = g + s y = Cells(Rows.Count, "t").End(xlUp).Row + 1 Sheets("Лист2").Range("a" & g - 1 & ":h" & g - 1).Copy Range("t" & y) Next a = Cells(Rows.Count, "q").End(xlUp).Row + 1 b = Cells(Rows.Count, "t").End(xlUp).Row Range("q" & a & ":q" & b) = Range("k5").Value Range("r" & a & ":r" & b) = Range("k4").Value Range("s" & a & ":s" & b) = Range("k6").Value Application.ScreenUpdating = True End Sub
Nic70y, огромное спасибо, перенес к себе в файл все отлично работает, остался крайний вопрос, что нужно поменять чтобы скопированные массивы вставлялись как значения и например на другой лист книги [vba]
Код
Sheets("Лист2").Range("a" & g - 1 & ":h" & g - 1).Copy Range("t" & y)
[/vba]
Nic70y, огромное спасибо, перенес к себе в файл все отлично работает, остался крайний вопрос, что нужно поменять чтобы скопированные массивы вставлялись как значения и например на другой лист книги [vba]
Код
Sheets("Лист2").Range("a" & g - 1 & ":h" & g - 1).Copy Range("t" & y)