Browse and copy Data from SELECTED File with dynamic range

user_15895383 0
Viewed 403

I have this code to browse files from another workbook. then when i get the file, paste it on sheet1 range A10. when I go back looking for the next workbook, all I want is to paste that data in the next cell. It's like copying and pasting with dynamic ranges, how to do that? the thing is, my code will just overwrite the data i pasted earlier in the A10 range. obviously this is not what I want.

Sub Get_Data_From_File()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A1:E20").Copy
        ThisWorkbook.Worksheets("SelectFile").Range("A10").PasteSpecial xlPasteValues
        OpenBook.Close False
        Sheet2.Range("A10").Select

    End If
    Application.ScreenUpdating = True

End Sub
vba excel
2 Answers

if there is allways have data on 'A' row, then it would be work

Sub Get_Data_From_File()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A1:E20").Copy
         '----------------------------------------
         
        Dim ws As Worksheet
        Set ws = ThisWorkbook.Worksheets("SelectFile")
       
        Dim nextRow As Integer
        nextRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
        If nextRow = 0 Then nextRow = 10
        
         '----------------------------------------
        ws.Range("A" & nextRow).PasteSpecial xlPasteValues
        OpenBook.Close False
        Sheet2.Range("A" & nextRow).Select

    End If
    Application.ScreenUpdating = True

End Sub
user_158511400

Copy Range From Another Workbook

Option Explicit

Sub Get_Data_From_File()
    
    ' Source
    Const sID As Variant = 1
    Const sRange As String = "A1:E20"
    
    ' Destination
    Const dName As String = "SelectFile"
    Const dFirst As String = "A10"
    
    ' Open Source
    Dim swbName As Variant
    swbName = Application.GetOpenFilename( _
        Title:="Browse for your File & Import Range", _
        FileFilter:="Excel Files (*.xls*),*xls*")
    
    If swbName = False Then Exit Sub
        
    Application.ScreenUpdating = False
  
    ' Source
    Dim swb As Workbook: Set swb = Workbooks.Open(swbName)
    Dim srg As Range: Set srg = swb.Worksheets(sID).Range(sRange)
    
    ' Destination
    Dim dwb As Workbook: Set dwb = ThisWorkbook
    Dim dws As Worksheet: Set dws = dwb.Worksheets(dName)
    With dws.Range(dFirst)
        Dim rg As Range
        Set rg = .Resize(.Worksheet.Rows.Count - .Row + 1, _
            .Worksheet.Columns.Count - .Column + 1)
        Dim lCell As Range
        Set lCell = rg.Find("*", , xlFormulas, , xlByRows, xlPrevious)
        Dim dCell As Range
        If lCell Is Nothing Then
            Set dCell = .Offset
        Else
            Set dCell = .Offset(lCell.Row - .Row + 1)
        End If
    End With
    
    ' Copy
    dCell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value
    
    ' Close
    swb.Close False
    
    ' Finishing Touches
    dwb.Activate
    dws.Activate
    ActiveWindow.ScrollRow = dCell.Row
    ActiveWindow.ScrollColumn = dCell.Column
    dCell.Select

    Application.ScreenUpdating = True

End Sub
user_98140690
Related