Скопируйте данные из другой книги без жесткого указания пути к файлу

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