Question

当我执行“代入”代码并将每个文件中的数据粘贴到“思科数据库”文件中时，下面的代码效果很好。但是，当我运行它时，它总是会丢弃最后一个文件。我每次都添加了一个特定的行来保存DB文件，但无济于事。有什么建议吗？

Sub AppendDataFinal()

Dim myWorkbook As String
myDB = "CiscoDatabase.xlsx"
myWorkbook = "Cisco.xlsm"

Application.Run "'Cisco.xlsm'!importfile" //grabs all .csv files from a folder

For Each wb In Workbooks
If (wb.Name <> myWorkbook) Then wb.Activate

Columns("A:O").Select
Selection.Delete Shift:=xlUp
Columns("O:AS").Select
Selection.Delete Shift:=xlUp


Selection.CurrentRegion.Select
Selection.Copy
Workbooks.Open ("file path")
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste , False
Range("A1").Select
If (ActiveWorkbook.Name = myDB) Then ActiveWorkbook.Save
ActiveWorkbook.Close
ActiveWorkbook.Close savechanges:=False

Next wb


Workbooks.Open ("file path and name")

Application.Run "Cisco.xlsm!DateFormat" //trims time off date row, pretties up data


End Sub

Answer 1

使用集合的不同方法（未经测试）

Sub AppendDataFinal()

Const MY_DB_PATH As String = "C:\pathToYourDBHere\"
Const MY_DB As String = "CiscoDatabase.xlsx"

Dim colNames As New Collection, wbName
Dim wb As Workbook
Dim wbDB As Workbook
Dim myDB As String

    importfile  'grabs all .csv files from a folder

    For Each wb In Workbooks
        'ThisWorkbook refers to the workbook containing this code
        If wb.Name <> ThisWorkbook.Name Then colNames.Add wb.Name
    Next wb

    'open the destination workbook
    Set wbDB = Workbooks.Open(MY_DB_PATH & MY_DB)

    For Each wbName In colNames

        Set wb = Workbooks(wbName)
        With wb.Sheets(1)
            .Columns("A:O").Delete Shift:=xlUp
            .Columns("O:AS").Delete Shift:=xlUp
            .Range("A1").CurrentRegion.Copy _
                  wbDB.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End With
        wb.Close False
        wbDB.Save

    Next wbName

    wbDB.Activate
    DateFormat 'trims time off date row, pretties up data

End Sub

VBA代码在逐步执行时，在运行时跳过文件

1 个答案: