Question

我试图将500个CSV文件中的数据全部放在一个文件夹中（xlsm文件位于同一个文件夹中）。我有一个vba检查工作表中是否有足够的可用行以适合要复制/粘贴的下一个文件，如果没有，那么它将创建一个新工作表并从范围（a1）开始在新表上。最后的msgbox只是一个双重检查，以确保所有文件都在复制。

问题是某些数据没有复制，我无法弄清楚原因。想法？

Public CurrRow, RemRows, TotRows As Long

Sub Open_CSV()

Dim MyFile, FolderPath, myExtension As String
'Dim MyObj As Object, MySource As Object, file As Variant
Dim csv As Variant
Dim wb As Workbook
Dim strDir As String
Dim fso As Object
Dim objFiles As Object
Dim obj As Object
Dim lngFileCount, lastrow As Long

FolderPath = Application.ActiveWorkbook.Path & Application.PathSeparator 'assigning path to get to both workbooks folder
myExtension = "*.csv" 'only look at csv files
MyFile = Dir(CurDir() & "\" & myExtension) 'setting loop variable to ref folder and files

'getting a count of total number of files in folder
strDir = Application.ActiveWorkbook.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFiles = fso.GetFolder(strDir).Files
lngFileCount = objFiles.Count

y = lngFileCount - 2 'folder file count minus tool.CSV_Import2 file

x = 1 'setting loop counter
Z = 1 'setting counter for new sheets
TotRows = 1048576 'total number of rows per sheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False


Do While MyFile <> ""
    Set wb = Workbooks.Open(Filename:=FolderPath & MyFile)
        wb.Activate

        With ActiveSheet
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With

        If x = 1 Then 'need to make the first paste of data in the first row
            Range("A1").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Windows("tool.CSV_Import2.xlsm").Activate
            Range("A1").Select
            ActiveSheet.Paste

        Else
            Range("A1").Select 'making all pastes after the first file to the next empty row
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy

            Windows("tool.CSV_Import2.xlsm").Activate
            Range("A1").Select
            Selection.End(xlDown).Select
            Selection.Offset(1, 0).Select
            CurrRow = ActiveCell.Row 'last row with data number
            RemRows = TotRows - CurrRow 'how many rows are left?

            If lastrow < RemRows Then 'if the import has fewer row than available rows
                ActiveSheet.Paste
            Else
                Sheets.Add.Name = Z
                Sheets(Z).Activate
                    Z = Z + 1
                Range("A1").Select 'direct paste here is applicable since it's the first paste
                ActiveSheet.Paste
            End If
        End If

    wb.Close 'close file

    If x = y Then 'if loop counter is equal to number of csv files in folder exit loop
        Exit Do
    End If

    x = x + 1

Loop

MsgBox x

End Sub

Answer 1

您的数据是否有差距＆＃39;在它？

如果是这样，即使下面可能有数据，您的行[{1}}也会选择差距。

尝试将这些更改为Range(Selection, Selection.End(xlDown)).Select

回复您的评论：

是的，看起来也是这样。为确定问题做得很好。您似乎无法在“我的未成年人”中的任何地方更改MyFile＆lt;＆gt; ＆＃34;＆＃34; ＆＃39;循环。

建议您考虑对此循环进行分区，以支持“对于每个wb in objFiles＆＃39;循环并相应调整您的代码。使用此方法，您无需计算，跟踪或测试文件进度的位置。

Answer 2

我需要添加

MyFile = Dir

在代码末尾的“循环”之前。

这使我能够遍历每个文件。

将粘贴CSV文件复制到一个xlsm工作簿

2 个答案: