Copy range of cells from one workbook to another

Question

How can a range of cells be copied from one workbook to another? The code below does not work. I believe there is something wrong with how the range of cells are selected: 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

Don't use select. Find last row and last column. Also, if pasting values, just set ranges to each other. — findwindow
– findwindow, Commented Jun 17, 2022 at 18:52

Lee Stevens · Accepted Answer · 2022-06-17 21:29:35Z

Replace:

sht1.Range("A1:D1").Select sht1.Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents

With

sht1.Range("A1:D" & Range("D1").End(xlDown).Row).Clear

Unless you specifically want to manually highlight the cells and then run the macro, this solution works.

This replacement code will now highlight every cell between "A1:D1" however, XlDown is only applied on the column "D".

VBasic2008 · Accepted Answer · 2022-06-18 09:04:53Z

Copy the Values of a Range

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

Collectives™ on Stack Overflow

Copy range of cells from one workbook to another

2 Answers 2

Comments

Copy the Values of a Range

Comments

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

Copy the Values of a Range

Comments

Related