Помогите создать кнопку, при нажатии которой создаётся новый лист с названием "Данные", далее на этот лист копируется всё с первого листа, и после копирования удаляются ячейки A1:N34 на новом листе. Начал писать такой код:
Помогите создать кнопку, при нажатии которой создаётся новый лист с названием "Данные", далее на этот лист копируется всё с первого листа, и после копирования удаляются ячейки A1:N34 на новом листе. Начал писать такой код:
Sub tt() ActiveSheet.Copy after:=Sheets(ThisWorkbook.Sheets.Count) ActiveSheet.Range("A1:N34").Clear End Sub
[/vba]
Забыл про название [vba]
Код
Sub tt() ActiveSheet.Copy after:=Sheets(ThisWorkbook.Sheets.Count) On Error Resume Next With ActiveSheet .Range("A1:N34").Clear .Name = "Данные" End With End Sub
[/vba]
Ячейки именно удаляются (если да, то со сдвигом вверх или влево?) или стираются? В приведенном макросе стираются (очищаются)
Так нужно? [vba]
Код
Sub tt() ActiveSheet.Copy after:=Sheets(ThisWorkbook.Sheets.Count) ActiveSheet.Range("A1:N34").Clear End Sub
[/vba]
Забыл про название [vba]
Код
Sub tt() ActiveSheet.Copy after:=Sheets(ThisWorkbook.Sheets.Count) On Error Resume Next With ActiveSheet .Range("A1:N34").Clear .Name = "Данные" End With End Sub
[/vba]
Ячейки именно удаляются (если да, то со сдвигом вверх или влево?) или стираются? В приведенном макросе стираются (очищаются)_Boroda_
Worksheets.Add after:=Sheets(Sheets.Count) Err.Clear On Error Resume Next ActiveSheet.Name = "Данные" If Err.Number = 0 Then Worksheets(1).Cells.Copy Destination:=Cells Range(Cells(1, 1), Cells(34, 14)).Clear Else Application.DisplayAlerts=False ActiveSheet.Delete End If
End Sub
[/vba] Так?
[vba]
Код
Sub Кнопка()
Worksheets.Add after:=Sheets(Sheets.Count) Err.Clear On Error Resume Next ActiveSheet.Name = "Данные" If Err.Number = 0 Then Worksheets(1).Cells.Copy Destination:=Cells Range(Cells(1, 1), Cells(34, 14)).Clear Else Application.DisplayAlerts=False ActiveSheet.Delete End If
Worksheets.Add after:=Sheets(Sheets.Count) Err.Clear On Error Resume Next ActiveSheet.Name = "Данные" If Err.Number = 0 Then Worksheets(1).Cells.Copy Destination:=Cells Range(Cells(1, 1), Cells(34, 14)).Delete Shift:=xlUp Else Application.DisplayAlerts = False ActiveSheet.Delete End If
Worksheets.Add after:=Sheets(Sheets.Count) Err.Clear On Error Resume Next ActiveSheet.Name = "Данные" If Err.Number = 0 Then Worksheets(1).Cells.Copy Destination:=Cells Range(Cells(1, 1), Cells(34, 14)).Delete Shift:=xlUp Else Application.DisplayAlerts = False ActiveSheet.Delete End If
Sub tt() On Error Resume Next aaa = Sheets("Данные").Cells(1) If Err = 0 Then Exit Sub On Error GoTo 0 Application.ScreenUpdating = 0 Application.Calculation = xlCalculationManual ActiveSheet.Copy after:=Sheets(ThisWorkbook.Sheets.Count) With ActiveSheet .Range("A1:N34").Delete Shift:=xlUp .Name = "Данные" End With Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = 1 End Sub
[/vba]
Или такой вариант [vba]
Код
Sub tt() On Error Resume Next aaa = Sheets("Данные").Cells(1) If Err = 0 Then Exit Sub On Error GoTo 0 Application.ScreenUpdating = 0 Application.Calculation = xlCalculationManual ActiveSheet.Copy after:=Sheets(ThisWorkbook.Sheets.Count) With ActiveSheet .Range("A1:N34").Delete Shift:=xlUp .Name = "Данные" End With Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = 1 End Sub