将一张表复制到不同的工作簿…但粘贴值?

感谢您的帮助。 我已经想通了,并成功地提出了代码来执行我所需要的。 我还有一个问题,希望你能帮上忙。 附上是我的代码,注意大胆的部分。 我想sourceSheet复制为一张纸,并粘贴在targetSheet(“NewBook”Sheet2),但我希望它粘贴为值。 这里是需要查看的具体部分…下面是完整的代码。

Set sourceBook = Application.Workbooks.Open(sourceFilename) Set sourceSheet = sourceBook.Sheets("Current") Set targetSheet = NewBook.Sheets("Sheet2") sourceSheet.Copy targetSheet Set targetSheet = NewBook.Sheets("Current") targetSheet.Name = "Previous" 

  Sub Subtype() Dim sourceBook As Workbook Dim filter As String Dim caption As String Dim sourceFilename As String Dim sourceSheet As Worksheet Dim targetSheet As Worksheet If customerFilename = "False" Then ' GoTo Here: End If filter = "Text files (*.xlsx),*.xlsx" caption = "Please Select an input file " sourceFilename = Application.GetOpenFilename Set NewBook = Workbooks.Add With NewBook .Title = "Subtype Practice" End With Set sourceBook = Application.Workbooks.Open(sourceFilename) Set sourceSheet = sourceBook.Sheets("Current") Set targetSheet = NewBook.Sheets("Sheet2") sourceSheet.Copy targetSheet Set targetSheet = NewBook.Sheets("Current") targetSheet.Name = "Previous" sourceBook.Close Dim sourceBook1 As Workbook Dim sourceFilename1 As String Dim sourceSheet1 As Worksheet Dim targetSheet1 As Worksheet sourceFilename1 = Application.GetOpenFilename Set sourceBook1 = Application.Workbooks.Open(sourceFilename1, Password:="BMTBD") Set sourceSheet1 = sourceBook1.Sheets("Data") Set targetSheet1 = NewBook.Sheets("Sheet1") sourceSheet1.Copy targetSheet1 Set targetSheet1 = NewBook.Sheets("Data") targetSheet1.Name = "Current" Application.DisplayAlerts = False Sheets("Sheet1").Delete Application.DisplayAlerts = True End Sub 

您的发布代码与您的描述不太一致。

未经testing:

 Sub NewPractice() Dim wbSrc as workbook, shtSrc as worksheet Dim shtDest as worksheet FileToOpen = Application.GetOpenFilename _ (Title:="Please Choose the RTCM File", _ FileFilter:="Excel Binary Worksheet *.xlsb (*.xlsb),") If FileToOpen = False Then MsgBox "No file specified.", vbExclamation, "Duh!!!" Exit Sub Else Set shtDest = ActiveSheet Set wbSrc = Workbooks.Open(FileName:=FileToOpen, PassWord:="passhere") Set shtSrc = wbSrc.Sheets("Sheet1") End If shtDest.Range("A1:Z65536").ClearContents lrow = shtSrc.Cells(Rows.Count, 1).End(xlUp).Row 'EDIT shtDest.range("A1:Z" & lrow).Value = _ shtSrc.Range("A1:Z" & lrow).Value End Sub 

尝试这个。 我不是100%的密码。 我会尽快给您回复。

 Sub FileImporter() Dim sourceBook As Workbook Dim targetBook As Workbook 'Add this Dim filter As String Dim caption As String Dim sourceFilename As String Dim sourceSheet As Worksheet Dim targetSheet As Worksheet If customerFilename = "False" Then GoTo Here: End If filter = "Text files (*.xlsx),*.xlsx" caption = "Please Select an input file " sourceFilename = Application.GetOpenFilename(filter, , caption) Set sourceBook = Application.Workbooks.Open(Filename:=sourceFilename, _ Password:=" ") 'The password goes here Set sourceSheet = sourceBook.Sheets("Current") Set targetBook = Workbooks(" ") 'The workbook you're copying TO goes here Set targetSheet = targetBook.Sheets("Sheet2") sourceSheet.Copy targetSheet targetSheet.Name = "Previous" sourceBook.Close Here: End Sub