Results 1 to 3 of 3

Thread: VBA Script to import Sheet content from external workbook

  1. #1

    VBA Script to import Sheet content from external workbook

    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hey guys,

    I want to use the script below to copy:
    - the content of Sheet "RAWDATA" in file C:\Client Reports\Delivery.xls
    - into Sheet "RAWDATAClient" in the active workbook

    but don't know where to specify the source file and the destination sheet
    Can you help me?

    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
        Application.ScreenUpdating = False ' turn off the screen updating
        ' perform import
        Set TargetRange = Range(TargetAddress).Cells(1, 1)
        Set SourceRange = SourceWB.Worksheets(SourceSheet).Range(SourceAddress)
        For A = 1 To SourceRange.Areas.Count
            If PasteValuesOnly Then
                TargetRange.PasteSpecial xlPasteValues
                TargetRange.PasteSpecial xlPasteFormats
                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
        Application.ScreenUpdating = True ' turn on the screen updating
    End Sub

    Thank you very much!

    Cross-posted here.
    Last edited by JoePublic; 2013-10-03 at 12:42 PM. Reason: Add link to cross-post

  2. #2
    Since no one has replied, I am trying to reply your query.
    I am still learning. You seem to know more than I know.
    Yet, try this:
    Private Sub CommandButton2_Click()
     Call ImportRangeFromWB
    End Sub
    Private Sub ImportRangeFromWB()
     Dim book1 As Workbook
     Dim book2 As Workbook
     Dim book2Name As String
     book2Name = "Delivery.xls"
     Dim book2NamePath As String
     book2NamePath = "C:\Client Reports\" & book2Name
     Set book1 = Workbooks("SourceFile.xls")
     Set myData = Workbooks.Open(book2NamePath)
     Set book2 = Workbooks(book2Name)
     'Clear Contents to show just new search data
     Dim LstRow As Long
     Dim RowCtr As Long
     LstRow = book1.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row 'to go to last data cell inspite of blank cells.  Counts Lat Row that has data in this column.
     RowCtr = 1
      RowCtr = RowCtr + 1
      'pull data from Book1 and paste data in Book2
      'RowCtr=Row to pull/paste data. 1=Col to pull/paste data
      book2.Sheets(1).Cells(RowCtr, 1) = book1.Sheets(1).Cells(RowCtr, 1) 'Col A
      book2.Sheets(1).Cells(RowCtr, 2) = book1.Sheets(1).Cells(RowCtr, 2) 'Col B
      book2.Sheets(1).Cells(RowCtr, 3) = book1.Sheets(1).Cells(RowCtr, 3) 'Col C
      'here you add more columns
     Loop While RowCtr < LstRow 'will stop if RowCtr > LstRow
    End Sub
    Hope this helps. Someone may have a better suggestion.

  3. #3
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Excel Version
    Well, the instruction and an example are given at the beginning of the sub. The problem is not knowing the full extent of the source range before opening the file, so a slight alteration to the original sub:
    Set SourceRange = SourceWB.Worksheets(SourceSheet).Range(SourceAddress)
    If SourceAddress = "" Then
      Set SourceRange = SourceWB.Worksheets(SourceSheet).UsedRange
      Set SourceRange = SourceWB.Worksheets(SourceSheet).Range(SourceAddress)
    End If
    Call the sub with:
    ImportRangeFromWB "C:\Client Reports\Delivery.xls", "RAWDATA", "", False, ActiveWorkbook.Name, "RAWDATAClient", "A1"
    All untested!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts