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

一些猜测，因为你没有提供所有细节

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 2

避免使用SendKeys，并且由于您仅粘贴值，因此您无需使用 <{em> 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

Answer 3

这就是我的工作。它会弹出一个选择文件夹，并将其中的所有数据复制到我当前的工作簿中。然后使用没有扩展名的文件名命名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

excel从工作簿2复制，粘贴到工作簿中

3 个答案: