Блог

Я пытаюсь скопировать и вставить лист в новую книгу, в новой книге не будет vba, поэтому я создаю книгу, затем один лист, и скопированные данные вставляются в этот лист. Для этого я должен ссылаться на лист, с которого копируются данные.

Лист, с которого копируются данные, будет постоянно меняться. Поэтому я ссылаюсь на лист, который нужно скопировать в ячейку B1 листа 1. Также имя целевого листа (новая книга и лист) также будет постоянно меняться, они назначаются из ячеек листа 1 B2, C2 исходного листа. Все это работает нормально,

Для получения дополнительной информации см. Сообщение MR Excel внизу.

Единственная часть, на которой я застрял, указана ниже и не может идти дальше. Это мой код. Я оставил в исходном коде, который работает, это закомментировано. Я также оставил некоторые из своих попыток.

Объект не поддерживает это свойство или метод

 wksh(CopySheet).UsedRange.Copy 'COPY THIS SHEET
 

Это код

 ''Copy and Paste Sheet
        Application.SheetsInNewWorkbook = 1 'Number of Sheets in New Workbook
        Workbooks.Add 'Add sheet to new workbook
        With ThisWorkbook ' Now with this workbook

'' ########## Refering to WORKBOOK   SHEET from which the data is to be copied From to new Sheet ########        
Dim wkb As Excel.Workbook
Dim wksh As Excel.Worksheet
Dim CopySheet As Variant

    Set wkb = Excel.Workbooks("Test Copy Sheet3B.xlsm") ' USE THIS WORKBOOK
    Set wksh = wkb.Worksheets("Sheet1") 'USE THIS SHEET

    wksh.Range("B1") = CopySheet 'COPY THE SHEET NAMED IN THIS CELL E.G Sheet10
    wksh(CopySheet).UsedRange.Copy 'COPY THIS SHEET
    'wksh.Range("B1").UsedRange.Copy
    'wks.Sheets(Sheets("Sheet1").Range("B1").Value).Copy
    'ActiveWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteValues = CopySheet
     ActiveWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteValues 'PASTE IN NEW CREATED WORKBOOK SHEET
     
'' ############### Original Code ###############
''Copy and Paste Sheet
'   Application.SheetsInNewWorkbook = 1
'        Workbooks.Add
'    With ThisWorkbook
'        .Sheets("Sheet2").UsedRange.Copy 'Copy this sheet
'        ActiveWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteValues
'        ActiveWorkbook.Sheets(1).Name = "Data Search" ' new sheet name     
'' ############### Original Code ###############
 

Я также опубликовал это в Mr Excel Здесь есть загружаемая рабочая книга и полный код, поскольку я исправил большинство проблем, последние несколько сообщений лучше всего разместить на странице 2 Mr Excel. Это последнее, на чем я зациклился.

Ответ ниже, большое спасибо Лууку за то, что он указал мне правильное направление.

Исправление

 ''Copy and Paste Sheet
        Application.SheetsInNewWorkbook = 1
        Workbooks.Add
        With ThisWorkbook
        
Dim wkb As Excel.Workbook
Dim wksh As Excel.Worksheet
Dim CopySheet As Variant

    Set wkb = Excel.Workbooks("Test Copy Sheet3B.xlsm") ' USE THIS WORKBOOK
    Set wksh = wkb.Worksheets("Sheet1") 'USE THIS SHEET
    CopySheet = wksh.Range("B1")
    .Sheets(CopySheet).UsedRange.Copy
    ActiveWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteValues 'PASTE IN NEW CREATED WORKBOOK SHEET
 

Полный код, также размещенный в Mr Excel, см. Ссылку выше

 Private Sub CommandButton3_Click()

Application.ScreenUpdating = False
If Sheets(Sheets("Sheet1").Range("B1").Value).Range("A2").Value = "" Then
'ExportError.Show
MsgBox "Nothing to report"
Else
''Copy and Paste Sheet
        Application.SheetsInNewWorkbook = 1
        Workbooks.Add
        With ThisWorkbook
'' ########## Refering to WORKBOOK   SHEET from which the data is to be copied From to new Sheet ########
Dim wkb As Excel.Workbook
Dim wksh As Excel.Worksheet
Dim CopySheet As Variant

    Set wkb = Excel.Workbooks("Test Copy Sheet3B.xlsm") ' USE THIS WORKBOOK, name must match
    Set wksh = wkb.Worksheets("Sheet1") 'USE THIS SHEET name must match
    CopySheet = wksh.Range("B1")
    .Sheets(CopySheet).UsedRange.Copy
    ActiveWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteValues 'PASTE IN NEW CREATED WORKBOOK SHEET
     
'' Rename Tab On new Sheet
    Dim TabName As Variant
        TabName = ThisWorkbook.Worksheets("Sheet1").Range("B2").Value
    ActiveWorkbook.Sheets(1).Name = TabName
''##################
 '' Format Header in new workbook
        ActiveWorkbook.Sheets(1).Columns("A:g").ColumnWidth = 25
        ActiveWorkbook.Sheets(1).Range("A1:g1").Font.Name = "Calibri"
        ActiveWorkbook.Sheets(1).Range("A1:g1").HorizontalAlignment = xlCenter
        ActiveWorkbook.Sheets(1).Range("A1:g1").Font.Color = vbWhite
        ActiveWorkbook.Sheets(1).Range("A1:g1").Interior.ColorIndex = 16 'Color Grey
' Create a Freeze panel on new sheet
   Dim wks As Worksheet
        For Each wks In Worksheets
            wks.Activate
                With Application.ActiveWindow
                .SplitColumn = 0
            .SplitRow = 1
        End With
        Application.ActiveWindow.FreezePanes = True
            If Not ActiveSheet.AutoFilterMode Then
                ActiveSheet.Range("A1").AutoFilter
            End If
        Next wks
'Fill all BLANK CELLS with Hyphen
    Dim r As Range, LastRow As Long
        LastRow = Cells(Rows.Count, "A").End(xlUp).Row
        For Each r In ActiveWorkbook.Sheets(1).Range("A1:g" amp; LastRow)
        If r.Text = "" Then r.Value = "-"
    Next r
'Rename Sheet
    Dim SheetName As Variant
   '   Application.DisplayAlerts = False
        SheetName = ThisWorkbook.Worksheets("Sheet1").Range("B3").Value
 'Save Sheet
    ActiveWorkbook.SaveAs Filename:=(SheetName) amp; Format(Now, " dd_mm_yyyy    HH_mm_ss") amp; ".xlsx", FileFormat:=51

   Application.ScreenUpdating = True
End With
End If
End Sub