Home > Enterprise >  How do I prompt a user for an excel sheet copy everything on the first sheet and then paste it to th
How do I prompt a user for an excel sheet copy everything on the first sheet and then paste it to th

Time:08-20

Essentially my problem is that I have an already open workbook that I am running the VBA code from. I want to prompt the user to open a csv excel file, copy everything in the first sheet (I don't know what the sheet name is) and then paste everything from that sheet to a sheet in my Active Workbook. Right now the code will prompt the user and will allow them to select a csv but I get an error on the line:

    Workbooks(FileToOpen).Activate

The error reads

"Subscript out of range"

Thanks for helping me on this.

    Sub Popular()

    FileToOpen = Application.GetOpenFilename _
    (Title:="Please Choose the RTCM File", _
    FileFilter:="Excel Files *.csv (*.csv),")

    If FileToOpen = False Then
        MsgBox "No file specified.", vbExclamation, "Duh!!!" ' Notification that nothing 
    is chosen
        Exit Sub
    Else ' Load the file, copy the first sheet and paste it in active sheet ...
    ThisWorkbook.Activate
    ThisWorkbook.ActiveSheet.Range("A1:Z65536").ClearContents
    Workbooks(FileToOpen).Activate
    lrow = Workbooks(FileToOpen).Sheets("Sheet1").Cells(65536, 1).End(xlUp).Row
    Workbooks(FileToOpen).Sheets("Sheet1").Range("A1:Z" & lrow).Copy
    ThisWorkbook.Activate
    ThisWorkbook.ActiveSheet.Range("A1").PasteSpecial xlPasteValues
End If

    End Sub

CodePudding user response:

There are 3 problems in your code.

  1. The reference to the "Sheet1", as you said you do not know the name so you should addres it per index (1).
  2. and you used the full path in the reference to a workbook where this is only the name of the file.
  3. You did not open the tile you wanted to copy. I opened it in read only mode

Also get used to declare local variables because you end up in a mess not doing so

Option Explicit
Sub Popular()
    Dim FileToOpen As Variant
    Dim lrow As Long
    Dim newWorkbook As Workbook
    
    FileToOpen = Application.GetOpenFilename _
    (Title:="Please Choose the RTCM File", _
    FileFilter:="Excel Files *.csv (*.csv),")

    If FileToOpen = False Then
        MsgBox "No file specified.", vbExclamation, "Duh!!!" ' Notification that nothing    is chosen
        Exit Sub
    Else ' Load the file, copy the first sheet and paste it in active sheet ...
        ThisWorkbook.Activate
        ThisWorkbook.ActiveSheet.Range("A1:Z65536").ClearContents
        Set newWorkbook = Application.Workbooks.Open(FileToOpen, , True)
        newWorkbook.Activate
        lrow = newWorkbook.Sheets(1).Cells(65536, 1).End(xlUp).Row
        newWorkbook.Sheets(1).Range("A1:Z" & lrow).Copy
        ThisWorkbook.Activate
        ThisWorkbook.ActiveSheet.Range("A1").PasteSpecial xlPasteValues
    End If

End Sub

CodePudding user response:

Import Data From a .csv File

Option Explicit

Sub ImportData()

    ' Reference the destination workbook ('dwb').
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code

    ' Attempt to reference the destination worksheet ('dsh'),
    ' a worksheet in the workbook containing this code.
    Dim dsh As Object: Set dsh = ActiveSheet
    If dsh Is Nothing Then
        MsgBox "No visible workbooks open.", vbCritical
        Exit Sub
    End If
    If Not dsh.Parent Is ThisWorkbook Then
        MsgBox "Select a worksheet in the workbook '" & dwb.Name & "'.", _
            vbCritical
        Exit Sub
    End If
    If dsh.Type <> xlWorksheet Then
        MsgBox "'" & dsh.Name & "' is not a worksheet.", vbCritical
        Exit Sub
    End If
    
    ' Let the user select the source file (workbook).
    Dim sFilePath As Variant: sFilePath = Application.GetOpenFilename _
        (Title:="Please Choose the RTCM File", _
        FileFilter:="Excel Files (*.csv),*.csv")
    If sFilePath = False Then
        MsgBox "No file specified.", vbExclamation, "Duh!!!"
        Exit Sub
    End If
    
    ' Open and reference the source workbook ('swb').
    Dim swb As Workbook: Set swb = Workbooks.Open(Filename:=sFilePath)
    ' If your list delimiter and the file delimiter are a semicolon (';'),
    ' use the following instead:
    'Set swb = Workbooks.Open(Filename:=sFilePath, Local:=True)
    
    ' Reference the source worksheet ('sws').
    Dim sws As Worksheet: Set sws = swb.Worksheets(1) ' the one and only
    
    ' Reference the source range ('srg'), the range to be copied.
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
    Dim srg As Range: Set srg = sws.Range("A1", sws.Cells(slRow, "Z"))
    
    ' Clear previous destination data.
    dsh.Range("A:Z").ClearContents
    
    ' Reference the destination range ('drg'), the range to be written to,
    ' a range of the same size as the source range.
    Dim dfCell As Range: Set dfCell = dsh.Range("A1")
    Dim drg As Range: Set drg = dfCell.Resize(srg.Rows.Count, srg.Columns.Count)
    
    ' Copy values (by assignment).
    drg.Value = srg.Value
    
    ' Close the source workbook.
    swb.Close SaveChanges:=False ' it was just read from, nothing to save

    ' Save the destination workbook.
    'dwb.Save

    ' Inform.
    MsgBox "Data imported.", vbInformation
    
End Sub
  • Related