1

助けてくれてありがとう。私はそれを理解し、必要なことを実行するためのコードをうまく思いつきました。もう 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 に答える