[英]Copy and Paste a excel sheet , Value of Sheet Cell Data to be referenced in code
我正在嘗試將工作表復制並粘貼到新工作簿中,新工作簿中不會有任何 vba 所以我正在創建一個工作簿,然后創建一個工作表並將復制的數據粘貼到該工作表中。 為此,我必須引用從中復制數據的工作表。
從中復制數據的工作表將不斷變化。 因此,我引用要在 Sheet1 單元格 B1 中復制的工作表。 此外,目標工作表(新工作簿和工作表)的名稱也會不斷變化,這些是從原始工作表的 Sheet1 單元格 B2、C2 分配的。 這一切工作正常,
有關更多信息,請參閱底部的 MR Excel 帖子。
我堅持的唯一部分如下所述,不能再進一步 go 了。 這是我的代碼。 我在原始代碼中留下了哪些工作,這被注釋掉了。 在我的一些嘗試中,我也離開了。
Object 不支持此屬性或方法
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 ###############
我還在 Excel 先生上發布了這個, 這里有一個可下載的工作簿和完整代碼,因為我已經解決了大部分問題,最后幾篇帖子最好在 Excel 先生的第 2 頁上。 這是我堅持的最后一點。
答案在下面,非常感謝 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
完整代碼,也發布在 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" & 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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.