Блог

У меня есть 2 набора диапазонов; Пути к исходным файлам и пути к файлам назначения.

Я хочу перебрать каждый список, чтобы открыть исходный файл и скопировать вкладку / лист в путь к файлу назначения.

Ниже приведен код, который я использовал для перебора списка источников и копирования данных с вкладки в этой книге и вставки их на именованный лист. Имя вкладки копирования указано в коде offset, 1 ниже, и имя вставки никогда не изменится.

Этот шаг подготавливает рабочую книгу, поэтому теперь я могу скопировать эту вкладку в совершенно отдельную рабочую книгу, которую я перечислил.

Возможно ли это эффективно сделать с помощью цикла for??

 Sub RollQuarter()

Dim Wbk As Workbook
Dim Wks As Worksheet
Dim Filepath As String, Filename As String, sStg As String
Dim oDic As Scripting.Dictionary
Dim rng As Range, c As Range
Dim varKey As Variant

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

Set oDic = New Scripting.Dictionary
oDic.CompareMode = TextCompare

sStg = ""

Set rng = Union(Range("dummy")) 'Source files
 
For Each c In rng.Cells
    If Not oDic.Exists(c.Value) Then
        oDic.Add c.Value, c.Offset(, 1).Value
    Else
        MsgBox "Duplicate Item found", vbInformation, "Error Message"
        Exit Sub
    End If
Next c

For Each varKey In oDic.Keys
    If Len(Dir(varKey)) = 0 Then
        If sStg = "" Then
            sStg = oDic.Item(varKey)
        Else
            sStg = sStg amp; ", " amp; vbCrLf amp; oDic.Item(varKey)
        End If
    Else
        On Error Resume Next
        Set Wbk = Workbooks.Open(varKey, False)
        On Error GoTo 0
        If Wbk Is Nothing Then
        Else
            With Wbk
                .Sheets(oDic.Item(varKey)).Cells.Copy
                .Sheets("dummy sheet").Cells.PasteSpecial xlPasteValues
                Application.CutCopyMode = False
                .Save
            End With

            Wbk.Close False
            Set Wbk = Nothing
        End If
    End If

Next varKey

.....

If Len(sStg) > 0 Then MsgBox "The below files do not exist" amp; vbCrLf _
                        amp; sStg, vbCritical

End Sub