1

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

2 回答 2

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
于 2013-06-19T18:31:35.660 回答
0

尝试这个。我不是 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
于 2013-06-19T18:42:37.383 回答