Скопируйте лист рядом с конкретным листом и переименуйте - PullRequest
0 голосов
/ 25 марта 2019

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

Копировать лист> Копировать выбранный лист (Active.Sheet)> Копировать перед листом> выбрать необходимый лист (ActiveSheet.Copy Before :) запросить лист

Public Sub CopySheetAndRename()
    Dim newName As String

    On Error Resume Next
    newName = InputBox("Enter the name for the copied worksheet")

    If newName <> "" Then
        ActiveSheet.Copy After:=Worksheets(Sheets.Count)
        On Error Resume Next
        ActiveSheet.Name = newName
    End If
End Sub

Я так изменился, но я не знаю, какая часть неправильная или правильная

Public Sub CopySheetAndRename()
   Dim newName As String 
   On Error Resume Next 
   newName = InputBox("Enter the name for the copied worksheet") 

   If newName <> "" Then 
   On Error Resume Next newName1 = InputBox("Enter the name to copy before worksheet") 

   If newName1 <> "" Then ActiveSheet.Copy before:=Worksheets(Worksheets(newName1).Index) 

   On Error Resume Next 

   ActiveSheet.Name = newName 

   End If 

End Sub 

Отредактировано ^^^

Мне нужно изменить этот код как имя листа или поисковый лист

ActiveSheet.Copy After:=Worksheets(Sheets.Count)

Я ожидаю, что на выходе будут скопированы листы с переименованием и рядом с конкретным листом (если есть 3 листа, скажем Лист1, Лист2 и Лист3. Если я копирую лист, скажем, лист1 и копирую рядом с листом) скажем sheet3, тогда он должен скопировать перед sheet3).

1 Ответ

0 голосов
/ 25 марта 2019

Попробуйте:

ActiveSheet.Copy After:=Worksheets(Worksheets("desired (particular) sheet").Index)

Замените desired (particular) sheet на название того особого листа, о котором вы говорите в своем вопросе.

Кроме того, если вы хотите скопировать Before просто замените слово After на Before

А также, если вы хотите скопировать конкретный лист, а не активный, замените ActiveSheet на Worksheets("Nameofthatsheet")

ОБНОВЛЕНИЕ № 2: ОП должен переименовать новый лист, созданный после копирования, поэтому новый код будет выглядеть примерно так:

Public Sub CopySheetAndRename()
Dim NewName As String
Dim SheetToCopy As String
Dim BeforeThisSheet As String
Dim wk As Worksheet
Dim WKexists As Boolean


Get_NewName:

NewName = InputBox("Enter the name for the new worksheet")

If Trim(NewName) = vbNullString Or Len(NewName) = 0 Or NewName = "" Then
    MsgBox "No name has been entered. Copy will be canceled", vbCritical, "ERROR"
    Exit Sub
Else
    For Each wk In ThisWorkbook.Worksheets
        If UCase(wk.Name) = UCase(NewName) Then
            MsgBox "The name entered already exists in this workbook. Please, type a different one", vbCritical, "ERROR"
            GoTo Get_NewName
        End If
    Next wk
End If

SheetToCopy = InputBox("Enter the name for the copied worksheet")

If SheetToCopy = vbNullString Or Len(SheetToCopy) = 0 Or SheetToCopy = "" Then
    Exit Sub
Else
    WKexists = False
    For Each wk In ThisWorkbook.Worksheets
        If UCase(wk.Name) = UCase(SheetToCopy) Then WKexists = True
    Next wk

    If WKexists = False Then
        MsgBox "There is not any worksheet with that name. Copy will be canceled", vbCritical, "ERROR"
        Exit Sub
    End If

End If


BeforeThisSheet = InputBox("Enter the name to copy before worksheet")

If BeforeThisSheet = vbNullString Or Len(BeforeThisSheet) = 0 Or BeforeThisSheet = "" Then
    Exit Sub
Else
    WKexists = False
    For Each wk In ThisWorkbook.Worksheets
        If UCase(wk.Name) = UCase(BeforeThisSheet) Then WKexists = True
    Next wk

    If WKexists = False Then
        MsgBox "There is not any worksheet with that name. Copy will be canceled", vbCritical, "ERROR"
        Exit Sub
    End If
End If

Worksheets(SheetToCopy).Copy before:=Worksheets(Worksheets(BeforeThisSheet).Index)

ActiveSheet.Name = NewName


End Sub

Должен признать, что это не самый элегантный способ, ноэто будет работать.

Код будет запрашивать 3 вещи:

  1. Новое имя для нового рабочего листа, который вы собираетесь создать
  2. Имялист, который вы хотите скопировать
  3. Имя листа, куда вы собираетесь вставить перед созданием копии с новым именем

Кроме того, код убедится, что вы используетеправильные имена листов:

  1. На шаге 1 он проверит, существует ли новое имя ужеs или нет, , потому что рабочая книга не может иметь 2 рабочих листа с одинаковым именем .
  2. На шагах 2 и 3 она проверит, существуют ли имена рабочих таблиц, , потому что они нуждаютсясуществует в рабочей книге .Если вы введете имя несуществующей рабочей таблицы, процесс будет отменен.

Это лучшее, что я могу сделать.Надеюсь, вы сможете адаптировать это к вашим потребностям.

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