复制并粘贴一个 excel sheet , Value of Sheet 单元格数据以在代码中引用

Question

我正在尝试将一个 sheet 复制并粘贴到一个新工作簿中，新工作簿中没有任何 vba，所以我正在创建一个工作簿，然后再创建一个 sheet并将复制的数据粘贴到 sheet 中。为此，我必须引用要从中复制数据的 sheet。

复制数据的sheet会不断变化。因此，我引用了要在 Sheet1 单元格 B1 中复制的 sheet。此外，目标 sheet（新工作簿和 sheet）的名称也会不断变化，这些是从原始 sheet 的 Sheet1 单元格 B2、C2 分配的。这一切都很好，

有关详细信息，请参阅底部的 MR Excel post。

我唯一坚持的部分如下所述，不能再继续了。这是我的代码。我在原来的代码中留下了有效的代码，这被注释掉了。我也留下了一些尝试。

对象不支持此属性或方法

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 ###############

我也post在 Excel 先生上编辑了这个 Here 有一个可下载的工作簿和完整的代码，因为我已经解决了大部分问题，最后几个 post 最好在 Excel 先生的第 2 页上。这是我坚持的最后一点。

Answer 1

答案在下面，非常感谢 Luuk 为我指明了正确的方向。

修复

''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

完整代码，post 编辑于 Excel 先生，见上文 post link

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" & 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) & Format(Now, " dd_mm_yyyy    HH_mm_ss") & ".xlsx", FileFormat:=51

   Application.ScreenUpdating = True
End With
End If
End Sub

复制并粘贴一个 excel sheet , Value of Sheet 单元格数据以在代码中引用

Copy and Paste a excel sheet , Value of Sheet Cell Data to be referenced in code

excel

vba

copy-paste