首页 文章

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

提问于
浏览 次
1

我试图应用一个宏，将一个特定的工作表（调用该工作表的 Headers “x”）从一个workBOOK（“x1”）复制并粘贴到一个主工作簿（调用该工作簿“xmaster”）之后它从工作簿x1复制并粘贴工作表，它还应该将工作表“x”的 Headers 重命名为单元格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”，它将从以前的工作簿重命名 . ）

谢谢！马修

excel vba loops excel-vba

2 回答

  • 0

    像这样？ （未测试）

    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
    回复于
  • 0

    这个位将有助于避免在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窗口部分 .

    回复于

相关问题