Snasui Excel Forum

Code: Select all

  Ret1 = Application.GetOpenFilename("Excel Files  (*.xls*),*.xls*,(*.CSV),*.CSV")_
    , "Please select file")
    If Ret1 = False Then Exit Sub  
    

Code: Select all

Private Sub CommandButton1_Click()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim Ret1 As Variant, i As Integer
    Dim arrAdd() As Variant
    Set wb1 = ActiveWorkbook

    Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
        , "Please select file", , True)
    If TypeName(Ret1) = "Boolean" Then Exit Sub
    arrAdd = Array("A1", "ZZ1", "BA1", "CA1")
    For i = 1 To UBound(Ret1)
        Set wb2 = Workbooks.Open(Ret1(i), False)
        wb2.Worksheets(1).UsedRange.Copy wb1.Worksheets("RF DATABASE").Range(arrAdd(i - 1))
        wb2.Close False
    Next i
End Sub

Code: Select all

Private Sub CommandButton1_Click()
Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook, wb4 As Workbook, wb5 As Workbook
    Dim Ret1, Ret2, Ret3, Ret4, Ret5
 
 '-------------------------------------
     Set wb1 = ActiveWorkbook
 
    '~~> Get the File
    Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Please select file")
    If Ret1 = False Then Exit Sub
 'Workbook#2-------------------------------------
 
    Set wb2 = Workbooks.Open(Ret1)
    wb2.Worksheets("Sheet1").Cells.Copy wb1.Worksheets("RF DATABASE").Cells("A1:Z")
    wb2.Close SaveChanges:=False
 '-------------------------------------
 
    Set wb2 = Nothing
    Set wb1 = Nothing
    MsgBox "DONE!!."
    
 'Workbook#3-------------------------------------
 
    Set wb3 = Workbooks.Open(Ret2)
    wb3.Worksheets("Sheet1").Cells.Copy wb1.Worksheets("RF DATABASE").Cells("ZZ1:AZ")
    wb3.Close SaveChanges:=False
 '-------------------------------------
 
    Set wb3 = Nothing
    Set wb1 = Nothing
    MsgBox "DONE!!."
    
 'Workbook#4-------------------------------------
 
    Set wb4 = Workbooks.Open(Ret3)
    wb4.Worksheets("Sheet1").Cells.Copy wb1.Worksheets("RF DATABASE").Cells("BA1:BZ")
    wb4.Close SaveChanges:=False
 '-------------------------------------
 
    Set wb4 = Nothing
    Set wb1 = Nothing
    MsgBox "DONE!!."
    
 'Workbook#5-------------------------------------
 
    Set wb5 = Workbooks.Open(Ret4)
    wb5.Worksheets("Sheet1").Cells.Copy wb1.Worksheets("RF DATABASE").Cells("CA1:CZ")
    wb5.Close SaveChanges:=False
 '-------------------------------------
 
    Set wb5 = Nothing
    Set wb1 = Nothing
    MsgBox "DONE!!."
    
End Sub