Как скопировать строку заголовка с исходного листа на вновь создаваемые листы - PullRequest
Новая
       11

Как скопировать строку заголовка с исходного листа на вновь создаваемые листы

0 голосов
/ 02 мая 2018

Привет! Я использовал этот код для копирования данных из моего обзорного листа в текущие листы или, если лист не существует, для его создания. Однако я изо всех сил пытаюсь решить, как добавить одну или две строки в бите else, чтобы скопировать строку заголовка (A1 - G1) из обзора и на новые листы. 

Sub CopyRows()

Dim rngMyRange As Range, rngCell As Range
Dim sht As Worksheet
Dim LastRow As Long
Dim SheetName As String



With Worksheets("Overview")
Set rngMyRange = .Range(.Range("D2"), .Range("D65536").End(xlUp))

For Each rngCell In rngMyRange

    rngCell.EntireRow.Select

    Selection.Copy

    If (WorksheetExists(rngCell.Value)) Then
        SheetName = rngCell.Value
        Sheets(SheetName).Select
        Set sht = ThisWorkbook.Worksheets(SheetName)
        LastRow = sht.Cells(sht.Rows.Count, "D").End(xlUp).Row
        Rows(LastRow + 1).Select
        Selection.Insert Shift:=xlDown
    Else
        Sheets.Add After:=ActiveSheet
        Rows("1:1").Select
        Selection.Insert Shift:=xlDown
        ActiveSheet.Name = rngCell.Value
     Sub copyheadernames()

   End Sub
   End If
    'Go back to the DATA sheet
    Sheets("Overview").Select
    Next

End With

End Sub

Function WorksheetExists(sName As String) As Boolean
WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
End Function

1 Ответ

0 голосов
/ 02 мая 2018

В начале подпрограммы я установил именованный диапазон, охватывающий заголовки обзора, а затем в другом разделе скопировал этот диапазон в требуемое место назначения, например,

... Dim SheetName As String Тусклые заголовки как диапазон

Установить заголовки = рабочие таблицы («Обзор»). Диапазон (A1: G1)

затем в другой части измените

headings.copy Место назначения: =

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

...