时间戳

首页 > 解决方案 > excel 宏/vba if/then 循环通过多个工作表在单元格中查找特定文本

excel - excel 宏/vba if/then 循环通过多个工作表在单元格中查找特定文本

问题描述

尝试创建一个宏来打开一个 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

标签： excelvba

解决方案

未测试

  1. &您使用运算符而不是运算符构建字符串+。你的声明folderpath = folderpath + "\"将失败。如果您的代码通过了此错误，则意味着以下两种情况之一（A：对于这种情况，您拥有On Error这不是一个好的陷阱，或者B：您尚未针对尚未以 '\' 结尾的文件夹路径测试此代码
  2. 限定你的对象。每个工作表对象都应使用该工作表进行限定。否则你可能会得到一些意想不到的输出，特别是因为你使用.Select
  3. 删除.Select. 当您可以明确说明代码应在何处运行时，无需依赖所选内容
  4. 声明变量来存储最后一行将使代码更简洁，更易于阅读。( 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

推荐阅读