【问题标题】:Copy One Sheet To Different Workbook...But Paste Values?将一张工作表复制到不同的工作簿...但是粘贴值?
【发布时间】:2013-06-19 16:51:54
【问题描述】:

感谢您的所有帮助。我已经想通了,并成功地提出了代码来执行我需要的东西。我还有一个问题,希望你能提供帮助。附上我的代码,注意加粗部分。我希望将 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 

【问题讨论】:

  • 最好包含您当前的代码,即使它不太有效。
  • 知道了,刚刚添加了@TimWilliams

标签: excel copy vba


【解决方案1】:

您发布的代码与您的描述不太相符。

未经测试:

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

【讨论】:

  • 谢谢蒂姆!它工作得很好,除了当我尝试使用它时它只复制第一行?
  • 我的错 - 它是从目标表设置 lrow... 查看编辑的行。
  • 嘿,刚刚更新了我的 OP ..谢谢你们,我想通了并且有一个成功的代码,但我只需要帮助弄清楚如何使用工作表 PasteSpecial Paste:=Values? (一直想不通)
【解决方案2】:

试试这个。我不是 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

【讨论】:

  • Al.Sal 看起来也不错,但它会说“运行时错误'9':下标超出范围在这一行::::: Set targetSheet = ThisWorkbook.表格(“表格 2”)
  • 我还考虑了密码,@AnilLulla
  • 嘿,刚刚更新了我的 OP ..谢谢你们,我想通了并且有一个成功的代码,但我只需要帮助弄清楚如何使用工作表 PasteSpecial Paste:=Values? (一直想不通
  • 我的荣幸!不要忘记选择您认为最好的答案:)
猜你喜欢
  • 1970-01-01
  • 1970-01-01
  • 2017-09-08
  • 2016-08-08
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2016-10-25
  • 1970-01-01
相关资源
最近更新 更多