Question

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

Answer 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

Answer 2

试试这个。我不是百分之百关于密码的做法;我会尽快给您回复。

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

将一张纸复制到不同的工作簿......但粘贴值？

2 个答案: