Question

zaveri cc on Fri, 22 Nov 2013 17:43:19


Hello Developers,

I have a code to open file dialogue box which will take user to their documents folder and allow user to select the file and than from that file data from sheet1 will be imported to existing xl file.

I need one change

When user selects the file that he wan't to import, file gets opened and user can scroll thourgh its tabs such as sheet1, sheet2 and sheet3 and than when user selects sheet 2 and select any cell for e.g A5 than data from row5 onwards shall be imported to existing xl.

steps

  1. open file dialogue box will open documents folder
  2. once user select xl file that file gets open
  3. user than can scroll through sheet1,2,3 or 4 and than when user selects sheet 3 and clcks on any cell for e.g A5 than row 5 onwards (non-empty rows) shall be copied to existing xl file

Here is the code which works fine to import data from sheet1 when user selects any xl file.

Sub CopyData()
    
    Dim fileDialog As fileDialog
    Dim strPathFile As String
    Dim strFileName As String
    Dim strPath As String
    Dim dialogTitle As String
    Dim wbSource As Workbook
    Dim rngToCopy As Range
    Dim rngRow As Range
    Dim rngDestin As Range
    Dim lngRowsCopied As Long
    
    
    dialogTitle = "Navigate to and select required file."
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
    With fileDialog
        .InitialFileName = "C:\Users\User\Documents"
        '.InitialFileName = ThisWorkbook.Path & "\" 'Alternative to previous line
        .AllowMultiSelect = False
        .Filters.Clear
        .Title = dialogTitle
        
        
        
        If .Show = False Then
            MsgBox "File not selected to import. Process Terminated"
            Exit Sub
        End If
        strPathFile = .SelectedItems(1)
    End With
     
    Set wbSource = Workbooks.Open(Filename:=strPathFile)
    
    With wbSource.Worksheets("Sheet1")      'Edit "Sheet1" to required sheet name
        Set rngToCopy = .Range(.Cells(1, "A"), .UsedRange.SpecialCells(xlCellTypeLastCell))
        For Each rngRow In rngToCopy.Rows
            If WorksheetFunction.CountA(rngRow) = 0 Then
                rngRow.EntireRow.Hidden = True    'Hides rows with no data
            End If
        Next rngRow
        
        Set rngDestin = ThisWorkbook.Sheets("Sheet1").Cells(1, "A")   'Edit "Sheet1" to destination sheet name
        
        rngToCopy.SpecialCells(xlCellTypeVisible).Copy Destination:=rngDestin
        
          lngRowsCopied = rngToCopy.Columns(1).SpecialCells(xlCellTypeVisible).Count
        MsgBox lngRowsCopied & " rows copied."

        
        .Rows.Hidden = False    'Unhides previously hidden rows
        
    End With
    
    wbSource.Close SaveChanges:=False
    
    Set fileDialog = Nothing
    Set rngRow = Nothing
    Set rngToCopy = Nothing
    Set wbSource = Nothing
    Set rngDestin = Nothing
    
    'MsgBox "The data is copied"

End Sub





Sponsored



Replies

zaveri cc on Fri, 22 Nov 2013 18:47:42


Thanks

Fei Xue on Mon, 25 Nov 2013 12:04:48


Hi zaveri,
According to your description, you want to copy the data of row which cell selected by users.
I modified the code a little below to achieve the goal. We can use input function to let user select a cell and get the reference object. And we can get the data of row through the End property of Range.

Sub CopyData()
    
    Dim fileDialog As fileDialog
    Dim strPathFile As String
    Dim strFileName As String
    Dim strPath As String
    Dim dialogTitle As String
    Dim wbSource As Workbook
    Dim rngToCopy As Range
    Dim rngRow As Range
    Dim rngDestin As Range
    Dim lngRowsCopied As Long
    
    
    dialogTitle = "Navigate to and select required file."
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
    With fileDialog
        .InitialFileName = "C:\Users\User\Documents"
        '.InitialFileName = ThisWorkbook.Path & "\" 'Alternative to previous line
       .AllowMultiSelect = False
        .Filters.Clear
        .Title = dialogTitle
        
        
        
        If .Show = False Then
            MsgBox "File not selected to import. Process Terminated"
            Exit Sub
        End If
        strPathFile = .SelectedItems(1)
    End With
     
    Set wbSource = Workbooks.Open(Filename:=strPathFile)
    Dim myRange As Range

    Set myRange = Application.InputBox(prompt:="Please select the cell you want to copy", Type:=8)
    Dim targetSheet As Worksheet
    Set targetSheet = wbSource.ActiveSheet
  
    'get the row of user select
   Set myRange = targetSheet.Range(targetSheet.Cells(myRange.Row, 1), targetSheet.Cells(myRange.Row, targetSheet.Columns.Count).End(xlToLeft))
    
    'copy data when there is an not empty cell in the range
    If WorksheetFunction.CountA(myRange) <> 0 Then
        Set rngDestin = ThisWorkbook.Sheets("Sheet1").Cells(1, "A")
              
        myRange.SpecialCells(xlCellTypeVisible).Copy Destination:=rngDestin
    End If

    wbSource.Close SaveChanges:=False
    
    Set fileDialog = Nothing
    Set rngRow = Nothing
    Set rngToCopy = Nothing
    Set wbSource = Nothing
    Set rngDestin = Nothing
    
    'MsgBox "The data is copied"

End Sub

Best regards

Fei

zaveri cc on Mon, 25 Nov 2013 15:39:19


Hi Fei, The code do not prompt the user to select the cell. The code do same thing as my code. It opens the documents Folder and once I select file it imports data without the excel File getting opened.

Fei Xue on Tue, 26 Nov 2013 01:46:10


Hi zaveri,

The code works well for me like fingure below:

Which version of Excel are you using? Would you mind sharing the Excel document with us for troubleshooting this issue? You can upload it to skydrive.

Best Regards

Fei

zaveri cc on Tue, 26 Nov 2013 15:23:28


I am using excel 2007.

This time your code works but if i select only one cell.

Ii need to select a range of cells for e.g i am selecting A2 TO N50 in this case code do not copy anything.

Fei Xue on Wed, 27 Nov 2013 01:26:24


Hi zaveri,

>>user than can scroll through sheet1,2,3 or 4 and than when user selects sheet 3 and clcks on any cell for e.g A5 than row 5 onwards (non-empty rows) shall be copied to existing xl file<<

From your original post, your requirement is that when user click any cell then the the current row shall be copied to existing xl file. But from the last reply, you may need to copy the selected rang. Did I understand correctly?

BTW, I test on my lab machine( Windows 7+ Excel 2007). If I select a range from Excel, the code will copy the fist row of the data. Could share us the orginal Excel file you test?

Best regards

Fei

Rahul De on Thu, 20 Mar 2014 06:29:06


Hi Fei,

Your code is exactly what I was looking for, for the past few months. It works absolutely great! However, I have a few varied requirements.
1. User has to browse for a particular workbook
2. User then selects the sheet required for copying
3. User then selects a range of columns required to be copied
4. VBA code copies columns C and D, along with the range, and pastes it in Sheet 2 in the Active Worbook

Please advise!

EDIT: The code I was working on is something along these lines-
Sub ImportData()
    Dim wkbCrntWorkBook As Workbook
    Dim wkbSourceBook As Workbook
     
    Dim rngSourceRange, rngSourceRange2 As Range
    Dim rngDestination, rngDestination2 As Range
   
    
    Set wkbCrntWorkBook = ActiveWorkbook
     
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "Excel 2002-03", "*.xls", 1
        .Filters.Add "Excel 2007", "*.xlsx; *.xlsm; *.xlsa", 2
        .AllowMultiSelect = False
        .Show
         
        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set wkbSourceBook = ActiveWorkbook
            'code to select sheet from the workbook
            Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="A1", Type:=8)
            Set rngSourceRange2 = wkbSourceBook.ActiveSheet.Cells(2, 4) ' required to select column D completely
            wkbCrntWorkBook.Activate
            Set rngDestination = ActiveSheet.Cells(2, 2)                ' paste destination must be column B onwards, i.e, whatever the user selects as range
            Set rngDestination2 = ActiveSheet.Cells(1, 1)               ' paste destination must be column A, i.e, from D of other sheet to A of this sheet
            rngSourceRange.copy rngDestination
            rngSourceRange2.copy rngDestination2
            
            
            rngDestination.CurrentRegion.EntireColumn.AutoFit
            wkbSourceBook.Close False
        End If
    End With
End Sub

Private Sub Import_Click()
    ImportData
End Sub

PatD985 on Fri, 06 Nov 2015 01:15:26


Hi

I am trying to perform the same action however for the entire range selected not just the row are you able to assist with this?

Jaredm1990a on Fri, 02 Mar 2018 14:16:53


Hello,

I know this is WAYYY late but I am using your macro.  Is it possible to paste the copied cells in a user defined cell instead of having it determined by the macro?