Import CSV per Dialog - VBA-CodePudding

I have this code to open Dialog and to import CSV into Excel, but when I run it, it only import the first row, I am not sure why. I can select everything, but it returns only the first row of CSV 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)
    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

What I want is to have everything from my CSV file copied to Excel file, but using Dialog, and then I use another Macro for text to columns. My CSV file always have one sheet. I am not sure how to update this code, thanks for helping.

CodePudding user response：

You need to change the second myRange.Row in this line to the last row of the sheet.

Set myRange = targetSheet.Range(targetSheet.Cells(myRange.Row, 1), targetSheet.Cells(myRange.Row, targetSheet.Columns.Count).End(xlToLeft))

Option Explicit

Sub CopyData()
    
    Dim fileDialog As fileDialog, dialogTitle As String
    Dim strPathFile As String, strPath As String
    
    Dim wbSource As Workbook
    Dim rngToCopy As Range, rngRow As Range, 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, ReadOnly:=True)
    Set rngToCopy = Application.InputBox(prompt:="Please select the cell you want to copy", Type:=8)
    
    Dim FirstRow As Long, LastRow As Long, LastCol As Long
    With wbSource.ActiveSheet
         'get the row of user select
         FirstRow = rngToCopy.Row
         LastCol = .Cells(FirstRow, .Columns.Count).End(xlToLeft).Column
         LastRow = .Cells(.Rows.Count, rngToCopy.Column).End(xlUp).Row
         lngRowsCopied = LastRow - FirstRow   1
        
         Set rngToCopy = .Range("A" & FirstRow).Resize(lngRowsCopied, LastCol)
    End With
    
    'copy data when there is an not empty cell in the range
    Dim msg As String
    msg = lngRowsCopied & " rows copied from " & rngToCopy.Address
    If WorksheetFunction.CountA(rngToCopy) <> 0 Then
         Set rngDestin = ThisWorkbook.Sheets("Sheet1").Range("A1")
         rngToCopy.Copy Destination:=rngDestin
         msg = lngRowsCopied & " rows copied from " & rngToCopy.Address
    Else
         msg = "No data to copy"
    End If
    
    wbSource.Close SaveChanges:=False
    MsgBox msg, vbInformation

End Sub