Question

试图创建一个打开excel工作簿的宏，转到第一个选项卡，在单元格a1中查找某些文本，如果匹配，则复制该工作表的一部分并粘贴到另一个工作簿中，然后转到下一个工作表。如果不匹配，则转到下一个工作表并完成上述操作。然后等等。

我已经编写了宏，但是它不起作用。我在移至下一个工作表时遇到问题。

Sub CopyTierSummarySpecific()
    Application.EnableCancelKey = xlDisabled
    Dim folderPath As String
    Dim Filename As String
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim i As Integer

    folderPath = "C:\2019\03 Mar" 'contains folder path
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
    Filename = Dir(folderPath & "*.xls*")
Do While Filename <> ""
        Application.ScreenUpdating = False
        Set wb = Workbooks.Open(folderPath & Filename)

        Sheets("Data").Select   'This is the first worksheet in all workbooks


For Each ws In ThisWorkbook.Worksheets


    If Range("A1").Value = "Include" Then
        Range("E16:AV" & Range("F" & Rows.Count).End(xlUp).Row + 1).Select
        Selection.Copy
        Windows("Test FPS.xlsm").Activate

        Worksheets("Summary").Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Else



    End If

 Next ws

Answer 1

未测试

您使用&运算符而不是+运算符来构建字符串。您对folderpath = folderpath + "\"的声明将失败。如果您的代码克服了此错误，则意味着以下两种情况之一（ A：，您有On Error不能很好地解决此问题，或者 B：您尚未针对尚未以'\'结尾的文件夹路径测试此代码
限定对象。每个工作表对象都应使用该工作表进行限定。否则，您可能会得到一些意外的输出，尤其是因为您使用的是.Select
删除.Select。当您可以明确声明代码应在何处运行时，无需依赖所选内容
声明变量来存储最后一行将使代码更整洁，更易于阅读。（cLR & pLR）

Sub CopyTier()

Dim fn As String, path As String
Dim wb As Workbook, ws As Worksheet
Dim cLR As Long, pLR As Long
Dim Book As Workbook: Set Book = Windows("Test FPS.xlsm")

path = "C:\2019\03 Mar"
fn = Dir(path & "*.xls*")

Do While fn <> ""
    Application.ScreenUpdating = False
        Set wb = Workbooks.Open(fn)

        If ws.Range("A1") = "Include" Then
            cLR = ws.Range("F" & ws.Rows.Count).End(xlUp).Row
            pLR = Book.Range("B" & Book.Rows.Count).End(xlUp).Offset(1).Row

            ws.Range("E16:AV" & cLR).Copy
            Book.Range("B" & pLR).PasteSpecial xlPasteValues
        End If

    Application.ScreenUpdating = True
Loop

End Sub

excel宏/ vba if /然后通过多个工作表循环查找某个单元格中的特定文本

1 个答案: