すべてをブック2からコピーし、ブックに貼り付けます

Question

私のサーバー上のブックからすべてのデータをコピーし、valuesをB2に別のブックに貼り付けようとしています。

これはこれまで私が行ってきたことです。これは、ブック2に私をもたらしますが、私はあなたがすべての詳細

を提供していないとして、ブックに1

Sub UpdateTSOM() 
    Application.ScreenUpdating = False 
    Dim LastRow As Long 
    Dim StartCell As Range 

    Set sht = Sheet5 
    Set reportsheet = Sheet5 
    Set StartCell = Range("B2") 

    'Refresh UsedRange 
    Worksheets("TSOM").UsedRange 

    'Find Last Row 
    LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 

    'Select Range 
    sht.Range("B2:B" & LastRow).Select 
    With Range("B2:B" & LastRow) 

     If MsgBox("Clear all Transmission Stock data?", vbYesNo) = vbYes Then 

      Worksheets("TSOM").Range("B2:N2000").ClearContents 

      MsgBox ("Notes:" & vbNewLine & vbNewLine & _ 'This is not needed if I can automate the copy and paste. 
      "Copy ALL" & vbNewLine & _ 
      "Paste as Values") 
     End If 
    End With 
    Workbooks.Open "P:\ESO\1790-ORL\OUC\_Materials\Stock Status\Transmission Stock Status **-**-**.xlsx" 
    ThisWorkbook.Activate 

    reportsheet.Select 
    Range("B2").Select 

    whoa: 'If filename changes then open folder 
    Call Shell("explorer.exe" & " " & "P:\ESO\1790-ORL\OUC\_Materials\Stock Status", vbNormalFocus) 
    Range("B2").Select 
    Application.ScreenUpdating = True 
End Sub 

おかげ

Answer 1

これは私が働くことです。選択されたファイルフォルダを開き、そこからすべてのデータを現在のワークブックにコピーします。次に、拡張子のないファイル名でB1（私のヘッダ）と名前をつけます。

Sub UpdateTSOM() 
Application.ScreenUpdating = False 
Dim vFile As Variant 
Dim wbCopyTo As Workbook 
Dim wsCopyTo As Worksheet 
Dim wbCopyFrom As Workbook 
Dim wsCopyFrom As Worksheet 
Dim s As String 

Set mycell = Worksheets("TSOM").Range("B1") 
Set wbCopyTo = ActiveWorkbook 
Set wsCopyTo = ActiveSheet 

If MsgBox("Update transmission Stock Status data?", vbYesNo) = vbYes Then 
Worksheets("TSOM").Range("B2:N3000").ClearContents 
Else: Exit Sub 
End If 

'Locate file to copy data from 
vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _ 
"*.xl*", 1, "Select Excel File", "Open", False) 

'Assign filename to Header 
s = Mid(vFile, InStrRev(vFile, "\") + 1) 
s = Left$(s, InStrRev(s, ".") - 1) 
mycell.Value = s 

Set wbCopyFrom = Workbooks.Open(vFile) 
Set wsCopyFrom = wbCopyFrom.Worksheets(1) 

'Copy Range 
wsCopyFrom.Range("A1:N3000").Copy 
wsCopyTo.Range("B2").PasteSpecial Paste:=xlPasteValues, _ 
Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

SendKeys "Y" 
SendKeys ("{ESC}") 

'Close file that was opened 
wbCopyFrom.Close SaveChanges:=False 
Application.Wait (Now + 0.000005) 
Call NoSelect 
Exit Sub 

End Sub 

Answer 2

いくつかの推測

を貼り付け、手動ですべて選択してコピーする必要があります

Sub UpdateTSOM() 

Application.ScreenUpdating = False 

Dim LastRow As Long 
Dim StartCell As Range 
Dim sht As Worksheet 
Dim wb As Workbook 

Set sht = Sheet5 
Set StartCell = sht.Range("B2") 

'Find Last Row 
LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 

If MsgBox("Clear all Transmission Stock data?", vbYesNo) = vbYes Then 
    Worksheets("TSOM").Range("B2:N2000").ClearContents 
End If 

Set wb = Workbooks.Open("P:\ESO\1790-ORL\OUC\_Materials\Stock Status\Transmission Stock Status **-**-**.xlsx") 
wb.Sheets(1).UsedRange.Copy 
StartCell.PasteSpecial xlValues 

Application.ScreenUpdating = True 

End Sub 

Answer 3

SendKeysを避け、そしてあなただけの値を貼り付けされているので、あなたはCopyまたはPaste/PasteSpecialのいずれかを使用する必要はありません。ここで

With wsCopyFrom.Range("A1:N3000") 
    wsCopyTo.Range("B2").Resize(.Rows.Count, .Columns.Count).Value = .Value 
End With 

を別のファイルから値をコピーするには、いくつかの他の方法があります。

Copy from one workbook and paste into another