![](/img/trans.png)
[英]Trying to copy a range of cells from one workbook to another using OPENPYXL
[英]Copy range of cells from one workbook to another
如何將一系列單元格從一個工作簿復制到另一個工作簿? 下面的代碼不起作用。 我認為選擇單元格范圍的方式有問題: sht1.Range("A1:D1").Select
Sub ImportData()
Dim wkb1 As Workbook
Dim sht1 As Worksheet
Dim wkb2 As Workbook
Dim sht2 As Worksheet
Application.ScreenUpdating = False
Set wkb1 = ThisWorkbook
Set wkb2 = Workbooks.Open("C:\Users\Temp\Desktop\MyExcelSheet.xlsm")
Set sht1 = wkb1.Sheets("Data")
Set sht2 = wkb2.Sheets("Summary")
'Function to clear the existing data. Doesn't work.
sht1.Range("A1:D1").Select
sht1.Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
' Copies data from the "Summary" sheet.
sht2.Range("O6:P102").Copy
sht2.Range("O6").Select
sht2.Range(Selection, Selection.End(xlToRight)).Select
sht2.Range(Selection, Selection.End(xlDown)).Select
Selection.Copy ' Copies all of the highlighted cells.
sht1.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
wkb2.Close True
Application.ScreenUpdating = True
MsgBox "Complete"
End Sub
代替:
sht1.Range("A1:D1").Select
sht1.Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
和
sht1.Range("A1:D" & Range("D1").End(xlDown).Row).Clear
除非您特別想手動突出顯示單元格然后運行宏,否則此解決方案有效。
此替換代碼現在將突出顯示“A1:D1”之間的每個單元格,但是 XlDown 僅應用於“D”列。
Option Explicit
Sub ImportData()
' Source (open, read from & close)
Const sFilePath As String = "C:\Users\Temp\Desktop\MyExcelSheet.xlsm"
Const sName As String = "Summary"
Const sFirstRowAddress As String = "O6:R6"
' Destination (write to & save)
Const dName As String = "Data"
Const dFirstCellAddress As String = "A1"
' Source
Dim swb As Workbook: Set swb = Workbooks.Open(sFilePath)
Dim sws As Worksheet: Set sws = swb.Worksheets(sName)
Dim srg As Range
With sws.Range(sFirstRowAddress)
Dim lCell As Range: Set lCell = .Resize(sws.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , xlByRows, xlPrevious)
If lCell Is Nothing Then
MsgBox "No data found.", vbCritical
Exit Sub
End If
Set srg = .Resize(lCell.Row - .Row + 1)
End With
' Destination
Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
Dim dws As Worksheet: Set dws = dwb.Worksheets(dName)
' Clear & copy.
With dws.Range(dFirstCellAddress).Resize(, srg.Columns.Count)
' Clear previous data.
.Resize(dws.Rows.Count - .Row + 1).Clear
' Copy values by assignment.
.Resize(srg.Rows.Count).Value = srg.Value
End With
' Save & close.
swb.Close SaveChanges:=False
'dwb.Save
' Inform.
MsgBox "Values copied.", vbInformation
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.