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

专业进口空白行

1 个答案: