簡體   English   中英

如何提示用戶輸入 excel 工作表復制第一張工作表上的所有內容,然后將其粘貼到活動工作表?

[英]How do I prompt a user for an excel sheet copy everything on the first sheet and then paste it to the Active Sheet?

基本上我的問題是我有一個已經打開的工作簿,我正在運行 VBA 代碼。 我想提示用戶打開 csv excel 文件,復制第一張工作表中的所有內容(我不知道工作表名稱是什么),然后將該工作表中的所有內容粘貼到我的活動工作簿中的工作表中。 現在代碼將提示用戶並允許他們使用 select 和 csv 但我在線上出現錯誤:

    Workbooks(FileToOpen).Activate

錯誤讀取

“下標超出范圍”

感謝您在這方面幫助我。

    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

您的代碼中有 3 個問題。

  1. 正如您所說,對“Sheet1”的引用您不知道名稱,因此您應該按索引(1)添加它。
  2. 並且您在對工作簿的引用中使用了完整路徑,其中這應該是文件的名稱。
  3. 您沒有打開要復制的文件。 我以只讀模式打開它

也習慣於聲明局部變量,因為你最終會陷入混亂而不這樣做

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

.csv文件導入數據

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 dwb 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 read from.
    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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM