专门进口的空白行

Question

我每天都有新的数据。这是我拼凑在一起的脚本，将其附加到集合中的第一个空白单元格。当我运行它时，脚本将它正确地粘贴到空白单元格中，但中间有数百甚至数千个空白行。

'Sub Read_CSV_Files()
Dim sPath As String
Dim oPath, oFile, oFSO As Object
Dim r, iRow As Long
Dim wbImportFile As Workbook
Dim wsDestination As Worksheet

'Files location
sPath = 'insert path here.
Set wsDestination = ThisWorkbook.Sheets("Raw Data")

r = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oPath = oFSO.GetFolder(sPath)
Application.ScreenUpdating = False
For Each oFile In oPath.Files
    If LCase(Right(oFile.Name, 4)) = ".csv" Then
        'open file to import
        Workbooks.OpenText Filename:=oFile.Path, Origin:=65001, StartRow:=2, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Comma:=True, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
        Set wbImportFile = ActiveWorkbook
        For iRow = 1 To wbImportFile.Sheets(1).UsedRange.Rows.Count
             wbImportFile.Sheets(1).Rows(iRow).Copy wsDestination.Rows(r)
            r = r + 1
        Next iRow
        wbImportFile.Close False
        Set wbImportFile = Nothing
    End If
Next oFile
End Sub

我还是个新手，这个脚本是从这个论坛上找到的另一个脚本拼凑而成的。任何帮助，将不胜感激。

Answer 1

基于 .UsedRange 的不可靠特性，我建议您更改这部分代码：

    For iRow = 1 To wbImportFile.Sheets(1).UsedRange.Rows.Count
         wbImportFile.Sheets(1).Rows(iRow).Copy wsDestination.Rows(r)
        r = r + 1
    Next iRow

为此：

    For iRow = 1 To wbImportFile.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
         wbImportFile.Sheets(1).Rows(iRow).Copy
         r = wsDestination.Range("A" & Rows.Count).End(xlUp).Row + 1
         wsDestination.Range("A" & r).PasteSpecial
    Next iRow

专门进口的空白行

Blank Rows On Specialized Import

excel

vba