从另一个工作簿复制数据而无需对文件路径进行硬编码

Question

我正在尝试将数据从一个工作簿复制并转置到另一个工作簿。每周要复制信息的文件都会更新到新的工作簿中。在我的宏中，我标注为“ 06-17-19 WGN WB A-line.xlsm周”。

我想手动打开工作表以复制数据，而不必对新日期进行硬编码。

我可以使用ActiveWorkbook函数调用新的打开的工作表吗？

Sub copytranspose()

Application.ScreenUpdating = False

Dim i As Integer
Dim Column As Integer
Dim Row As Integer
Row = 5
Column = 8

For i = 1 To 6
    Workbooks("Week of 06-17-19 WGN WB A-line.xlsm").Worksheets("WEEKLY").Cells(10, Column).Copy
    Column = Column + 2
    Workbooks("copy transpose.xlsm").Worksheets("sheet1").Cells(Row,3).PasteSpecial Paste:=xlPasteValues
    Row = Row + 1
Next i

End Sub

Answer 1

解决方案1 ​​

通过将要打开的文件的日期存储在单元格中，可以避免将日期硬编码到代码中。假设您有一个名为“ config”的工作表，在“ A1”范围内的日期为“ 06-24-19”。假设两个文件都在同一目录中，则可以编写如下内容

    Dim i As Integer
    Dim Column As Integer
    Dim Row As Integer
    Row = 5
    Column = 8

    Dim currFileDate As String
    currFileDate = Format(ThisWorkbook.Worksheets("Config").Range("A1").Value, "mm-dd-yy") '' Get the date typed in

    Dim srcDataWB As Workbook
    '' Open the workbook automatically with the file date of A1
    Set srcDataWB = Workbooks.Open(ThisWorkbook.Path & "\Week of " & currFileDate & " WGN WB A-Line.xlsm")

    For i = 1 To 6
        srcDataWB.Worksheets("WEEKLY").Cells(10, Column).Copy
            Column = Column + 2

            '' If this is the same workbook that the code is stored
            '' I suggest switching out Workbooks("copy transpose.xlsm") for ThisWorkbook
            Workbooks("copy transpose.xlsm").Worksheets("sheet1").Cells(Row, 3).PasteSpecial Paste:=xlPasteValues
        Row = Row + 1
    Next i

解决方案2

或者，如果您真正想要的只是匹配一个已打开的工作簿，且该工作簿与“ * WGN WB A-line.xlsm的周”模式匹配，则将可以进行以下操作。 但是这不是防弹的，因为您可能会打开两个与该模式匹配的工作簿。

Sub DoStuff()

    Dim i As Integer
    Dim Column As Integer
    Dim Row As Integer
    Row = 5
    Column = 8

    Dim srcDataWB As Workbook
    '' Get the already opened workbook that matches the pattern 'Week of * WGN WB A-line.xlsm'
    Set srcDataWB = GetSrcDataWB

    For i = 1 To 6
        srcDataWB.Worksheets("WEEKLY").Cells(10, Column).Copy
            Column = Column + 2

            '' If this is the same workbook that the code is stored
            '' I suggest switching out Workbooks("copy transpose.xlsm") for ThisWorkbook
            Workbooks("copy transpose.xlsm").Worksheets("sheet1").Cells(Row, 3).PasteSpecial Paste:=xlPasteValues
        Row = Row + 1
    Next i


End Sub

Function GetSrcDataWB() As Workbook

    Dim wbName As String
    Dim currWB As Workbook
    For Each currWB In Application.Workbooks
        If currWB.name Like "Week of * WGN WB A-line.xlsm" Then
            Set GetSrcDataWB = currWB
            Exit For '' No more need to loop
        End If
    Next

End Function