Question

我创建了一些编码，用于打开指定文件路径中的文件，搜索工作表并从我正在查找的工作表中复制所需信息，然后粘贴到编码所分配到的原始文档中。我需要复制的工作表名为MMM YY。当我最初设置编码时，我会每月手动更新，但是，我将文档传递给其他人使用，因此希望搜索引用是动态的。我创建了以下编码，其中'DRT'是动态参考，其中DRT = Today()格式化为MMM YY样式。

非常感谢

Option Explicit

Sub Macro1()

Dim ws As Worksheet
Dim Y As Workbook
Dim X As Workbook
Dim Filepath As String
Dim DRT As String

Filepath = ThisWorkbook.Worksheets("Calc").Range("Filepathdan").Value
DRT = ThisWorkbook.Worksheets("Calc").Range("DR").Value

Set Y = Application.ActiveWorkbook
Set X = Application.Workbooks.Open(Filename:=Filepath)

For Each ws In X.Sheets
    If InStr(1, ws.Name, DRT) Then
        Cells.Copy
        Y.Activate
        Worksheets("Dan").Range("A1").PasteSpecial (xlPasteValues)
        Worksheets("Dan").Range("A1").PasteSpecial (xlPasteFormats)
        Exit For
    End If
Next ws
X.Close False

End Sub

Answer 1

当您尝试使用Cells.Copy复制工作表时，您缺少工作表的引用，只需在开头添加ws，因此请使用ws.Cells.Copy。

此外，无需Activate Y Y.Activate工作簿，您应该使用Y.Worksheets("Dan").Range("A1").PasteSpecial xlPasteValues完全限定粘贴范围。

<强>代码

Option Explicit

Sub Macro1()

Dim ws As Worksheet
Dim Y As Workbook
Dim X As Workbook
Dim Filepath As String
Dim DRT As String

Filepath = ThisWorkbook.Worksheets("Calc").Range("Filepathdan").Value
'DRT = ThisWorkbook.Worksheets("Calc").Range("DR").Value
' ======= EDITED LINE ======
DRT = Format(ThisWorkbook.Worksheets("Calc").Range("DR").Value, "MMM YYYY")

Set Y = Application.ActiveWorkbook
Set X = Application.Workbooks.Open(Filename:=Filepath)

For Each ws In X.Sheets
    '=== for DEBUG ONLY ===
    Debug.Print DRT & " | Worksheet name is: " & ws.Name

    If InStr(1, ws.Name, DRT) > 0 Then
        ws.Cells.Copy
        Y.Worksheets("Dan").Range("A1").PasteSpecial xlPasteValues
        Y.Worksheets("Dan").Range("A1").PasteSpecial xlPasteFormats
        Exit For
    End If
Next ws
X.Close False

End Sub

动态工作表搜索

1 个答案: