Question

我找不到适合我的问题的现有线程，现在我卡住并寻求帮助;）

我想要完成的事情：填充内容的几个.xlsx表位于同一文件夹中，我想从每个文件中选择相同的两个单元格的内容，并将其保存到名为“Summary”的新创建的.xslx文件中。 XLSX”。

我的makro正确读出了单元格的内容，并保存了Summary.xlsx。但是看起来文件已损坏，因为当我尝试打开它时，Excel会向我显示一个空白页面（甚至不是一张纸）。

使用断点查看文件，标题得到正确编写：但是当我尝试在do-while-loop中编写其他文件的内容时，Summary.xlsx中的表开始消失。

附加信息：我使用模块中的播放按钮从与其他文件相同的目录中的额外makro文件启动makro。

这是我的代码。

警告：我是VBA的新手，显然：）

Sub MergeMakro()

Dim directory As String, fileName As String, otherWorkbook As Workbook, sumFileName As String, sumFilePath As String, i As Integer

thisFileName = "MergeMakro.xlsm"
sumFileName = "Summary.xlsx"
sumFilePath = ThisWorkbook.Path & "\" & sumFileName

' If sum file already exists, delete it
If Dir(sumFilePath) <> "" Then
Kill (sumFilePath)
End If

' create new sum file
Set sumWorkbook = Workbooks.Add
ActiveWorkbook.SaveAs fileName:=sumFilePath

Set sumSheet = sumWorkbook.ActiveSheet

' search in the file's directory
directory = "R:\ExcelStuff\Auswertungen\"

' headlines -> are written properly
sumSheet.Range("A1") = "Materialnummern"
sumSheet.Range("B1") = "Bezeichnung"
sumSheet.Range("C1") = "Gesamtkosten"

' start at line 2
i = 2

fileName = Dir(directory & "*.xls")

Do While fileName <> ""

    If fileName <> thisFileName And fileName <> sumFileName Then

        Set otherWorkbook = Workbooks.Open(directory & fileName)

        ' do not show windows
        If Not (ActiveWorkbook Is Nothing) Then
            ActiveWindow.Visible = False
        End If

        ' remove last 5 chars of string (.xlsx)
        fileName = Left(fileName, Len(fileName) - 5)

        ' do not try to open the makro-file itself
        Set otherSheet = otherWorkbook.Sheets(fileName)

        ' write data into file -> here the file starts to get corrupted
        sumSheet.Range("A" & i) = fileName
        sumSheet.Range("B" & i) = otherSheet.Range("C4")
        sumSheet.Range("C" & i) = otherSheet.Range("G4")

        i = i + 1

        otherWorkbook.Close

    End If

    ' get the next file
    fileName = Dir()

Loop

Workbooks(sumFileName).Save
Workbooks(sumFileName).Close

End Sub

提前致谢！

创建新的.xlsx文件并使用Excel VBA写入

0 个答案: