Question

我编写了一个代码，该代码转到具有文件名的特定工作表，并将数据复制到另一个名为DataSummary的工作表，代码为

      # # # # #
    # # # # # # #
  # # # # # # # # #
# # # # # # # # # # #
# # # # # # # # # # #
# # # # # # # # # # #
# # # # # # # # # # #
# # # # # # # # # # #
  # # # # # # # # #
    # # # # # # #
      # # # # #

现在这个代码在同一个工作表中使用时工作正常我有大约100本工作簿我想要编辑这段代码，以便它遍历所有工作簿并进行必要的编辑。

此后的下一步是将所有DataSummary工作表合并为一个工作簿

Answer 1

来自你的评论：

首先这个代码应该转到文件夹，打开每个文件然后转到名称从Ont开始的工作表，然后复制工作表的名称到列T的同一工作表，然后创建一个新的工作表在同一工作簿中调用DataSummary并复制旧的所有数据列A的值为ON的工作表

在你的代码中，我真的很困惑这是做什么XD

wbName = Left(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, ".") - 1)

我认为您希望将工作表名称存储到变量wbName，但这对于变量XD而言是一个可怕的名称。此外，它是相当混乱的解密哪本书和您希望从您的代码中找到哪张表但我制作了我的以下最佳尝试。

我无法轻松复制您的文件夹和文件，因此未经测试。进行备份。

Sub Macro1()

Dim MyFileName As String, MyPath As String
Dim newBook As Workbook
Dim ws As Worksheet

'Application.ScreenUpdating = False
'Application.DisplayAlerts = False

MyPath = "C:\testfiles\"
MyFileName = Dir(MyPath & "*.xls*")

Do Until MyFileName = ""

    Set newBook = Workbooks.Open(Filename:=MyPath & MyFileName)

    'add new sheet called DataSummary2
    newBook.Sheets.Add Type:=xlWorksheet
    ActiveSheet.name = "DataSummary2"

    For Each ws In newBook.Sheets

            If ws.name Like "*Ont*" Then

                lastRow1 = ws.UsedRange.Row - 1 + ws.UsedRange.Rows.Count 'not sure what the second half is doing XD
                strAddress2 = "T2:T" & lastRow1
                Range(strAddress2).Value = ws.name 'copy name of worksheet to column T

                lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

                'now copying to data summary
                For i = 2 To lastRow
                    If ws.Cells(i, "A").Value = "ON" Then
                    ws.Cells(i, "E").EntireRow.Copy Destination:=Sheets("DataSummary2").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    End If
                Next i

            End If
    Next

    newBook.Close True
    MyFileName = Dir

Loop

End Sub

Excel循环遍历工作簿的文件夹

1 个答案: