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

我试图从我的服务器上的工作簿中复制所有数据，并将values粘贴到另一个工作簿中的B2 。

这是我迄今为止。 它带我到工作簿2，但我必须手动select所有和复制，然后粘贴到工作簿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 ，因为你只是粘贴值，你不需要使用Copy或Paste/PasteSpecial 。

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

以下是将数值从一个文件复制到另一个文件的其他几种方法：

从一个工作簿复制并粘贴到另一个

Answer 3

这是我的工作。 它popup一个select的文件夹，并将其中的所有数据复制到我当前的工作簿中。 然后它命名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