Import from a Workbook/Worksheet
1999-10-13 Import & Export 0 298
This macro imports data from a workbook/worksheet to a worksheet range:
Sub ImportRangeFromWB(SourceFile As String, SourceSheet As String, _ SourceAddress As String, PasteValuesOnly As Boolean, _ TargetWB As String, TargetWS As String, TargetAddress As String) ' Imports the data in Workbooks(SourceFile).Worksheets(SourceSheet).Range(SourceAddress) ' to Workbooks(TargetWB).Worksheets(TargetWS).Range(TargetAddress) ' Replaces existing data in Workbooks(TargetWB).Worksheets(TargetWS) ' without prompting for confirmation ' Example ' ImportRangeFromWB "C:\FolderName\TargetWB.xls", _ "Sheet1", "A1:E21", True, ThisWorkbook.Name, "ImportSheet", "A3" Dim SourceWB As Workbook, SourceWS As String, SourceRange As Range Dim TargetRange As Range, A As Integer, tString As String Dim r As Long, c As Integer ' validate the input data if necessary If Dir(SourceFile) = "" Then Exit Sub ' SourceFile doesn't exist Set SourceWB = Workbooks.Open(SourceFile, True, True) Application.StatusBar = "Reading data from " & SourceFile Workbooks(TargetWB).Activate Worksheets(TargetWS).Activate ' perform import Set TargetRange = Range(TargetAddress).Cells(1, 1) Set SourceRange = SourceWB.Worksheets(SourceSheet).Range(SourceAddress) For A = 1 To SourceRange.Areas.Count SourceRange.Areas(A).Copy If PasteValuesOnly Then TargetRange.PasteSpecial xlPasteValues TargetRange.PasteSpecial xlPasteFormats Else TargetRange.PasteSpecial xlPasteAll End If Application.CutCopyMode = False If SourceRange.Areas.Count > 1 Then Set TargetRange = _ TargetRange.Offset(SourceRange.Areas(A).Rows.Count, 0) End If Next A ' clean up Set SourceRange = Nothing Set TargetRange = Nothing Range(TargetAddress).Cells(1, 1).Select SourceWB.Close False Set SourceWB = Nothing Application.StatusBar = False End Sub