我有這個代碼來打開 Dialog 并將 CSV 匯入 Excel，但是當我運行它時，它只匯入第一行，我不知道為什么。我可以選擇所有內容，但它只回傳 CSV 檔案的第一行。
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
我想要的是將我的 CSV 檔案中的所有內容復制到 Excel 檔案中，但使用 Dialog，然后我使用另一個宏將文本轉換為列。我的 CSV 檔案總是只有一張紙。我不知道如何更新此代碼，感謝您的幫助。
uj5u.com熱心網友回復：
您需要myRange.Row將此行中的第二行更改為作業表的最后一行。
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/qianduan/382711.html