Question

我正在尝试应用一个宏，它将一个特定的工作表（调用该工作表的标题“x”）从一个workBOOK（“x1”）复制并粘贴到一个主工作簿上（称为workBOOK“xmaster”）），在从工作簿x1复制并粘贴工作表之后，它还应该将工作表“x”的标题重命名为单元格B3。这应该在它移动到下一个工作簿之前完成。

需要为workBOOK x1执行此操作，比方说x100。我不能通过名称来引用工作簿，因为它们每个都被命名为一个文本字符串，并没有真正的可排序方法。

我知道此代码有效，将“x”从“x1”复制到“xmaster”，同时重命名工作表并断开链接，如下所示：

    Sub CombineCapExFiles()
    Sheets("Capital-Projects over 3K").Move After:=Workbooks("CapEx Master File.xlsm").Sheets _
        (3)
    ActiveSheet.Name = Range("B3").Value

    Application.DisplayAlerts = False

For Each wb In Application.Workbooks
    Select Case wb.Name
            Case ThisWorkbook.Name, "CapEx Master File.xlsm"
                ' do nothing
            Case Else
                  wb.Close
    End Select
Next wb

    Application.DisplayAlerts = True

End Sub

“激活上一个”窗口不起作用，也不确定如何修复它的那一部分。

然而，我不知道如何构建它来循环遍历目录中的所有workBOOK。

我应该用这个：？

MyPath = "C:\directory here"
strFilename = Dir(MyPath & "\*.xlsx", vbNormal) 'change to xlsm if needed ?

If Len(strFilename) = 0 Then Exit Sub ' exit if no files in folder

Do Until strFilename = ""
    'Your code here
    strFilename = Dir()    
Loop

另一个限制是它不需要在xmaster上运行宏（它会有一个错误，因为它不会有从前面的工作簿重命名的工作表“x”。）

谢谢！马修

Answer 1

像这样？（未经测试）

Option Explicit

Sub LoopFiles()

Dim strDir As String, strFileName As String
Dim wbCopyBook As Workbook
Dim wbNewBook As Workbook
Dim wbname as String   

strDir = "C:\"
strFileName = Dir(strDir & "*.xlsx")

Set wbNewBook = Workbooks.Add 'instead of adding a workbook, set = to the name of your master workbook
wbname = ThisWorkbook.FullName

 Do While strFileName <> ""
    Set wbCopyBook = Workbooks.Open(strDir & strFileName)
    If wbCopyBook.FullName <> wbname Then
        wbCopyBook.Sheets(1).Copy Before:=wbNewBook.Sheets(1)
        wbCopyBook.Close False
        strFileName = Dir()
    Else
        strFileName = Dir()
    End If
Loop

End Sub

Answer 2

这个位可以避免在xmaster上运行宏。

xmaster = "filename for xmaster"
MyPath = "C:\directory here"
strFilename = Dir(MyPath & "\*.xls*", vbNormal) 'this will get .xls, .xlsx, .xlsm and .xlsb files
If Len(strFilename) = 0 Then Exit Sub ' exit if no files in folder

Do Until strFilename = ""
    If strFileName = xmaster Then ' skip the xmaster file
        strFilename = Dir() 
    End If
    'Your code here
    strFilename = Dir()    
Loop

但是，我在另一方面无法帮助。我的代码中没有看到任何Activate Previous窗口部分。

Excel VBA：在文件夹中的多个工作簿上循环工作表的简单副本

2 个答案: