excel macro / vba if / then循環通過多個工作表查找單元格中的特定文本

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

未經測試

1. 使用&運算符而不是+運算符構建字符串。 您對folderpath = folderpath + "\\"將失敗。 如果你的代碼使它超過了這個錯誤，那就意味着兩件事之一（ 答：你有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