Excel Forum

Code: Select all

Function pull(xref As String) As Variant
'inspired by Bob Phillips and Laurent Longre
'but written by Harlan Grove
'-----------------------------------------------------------------
'Copyright (c) 2003 Harlan Grove.
'
'This code is free software; you can redistribute it and/or modify
'it under the terms of the GNU General Public License as published
'by the Free Software Foundation; either version 2 of the License,
'or (at your option) any later version.
'-----------------------------------------------------------------
Dim xlapp As Object, xlwb As Workbook
Dim b As String, r As Range, c As Range, n As Long

pull = Evaluate(xref)

If CStr(pull) = CStr(CVErr(xlErrRef)) Then
On Error GoTo CleanUp 'immediate clean-up at this point

Set xlapp = CreateObject("Excel.Application")
Set xlwb = xlapp.Workbooks.Add 'needed by .ExecuteExcel4Macro

On Error Resume Next 'now clean-up can wait

n = InStr(InStr(1, xref, "]") + 1, xref, "!")
b = Mid(xref, 1, n)

Set r = xlwb.Sheets(1).Range(Mid(xref, n + 1))

If r Is Nothing Then
pull = xlapp.ExecuteExcel4Macro(xref)
Else
For Each c In r
c.Value = xlapp.ExecuteExcel4Macro(b & c.address(1, 1, xlR1C1))
Next c

pull = r.Value
End If

CleanUp:
If Not xlwb Is Nothing Then xlwb.Close 0
If Not xlapp Is Nothing Then xlapp.Quit
Set xlapp = Nothing
End If
End Function

Code: Select all

Sub Test0()
    Dim rAll As Range
    Dim r As Range, strSource As String
    With Sheets("Sheet1")
        Set rAll = .Range("g1", .Range("g" & .Rows.Count).End(xlUp))
        For Each r In rAll
            strSource = "'" & r.Offset(0, -3) & "[" & r.Offset(0, -2) & "]" & _
                r.Offset(0, -1) & "'!"
            r.Offset(0, 2).Formula = "=" & strSource & r.Value
            r.Offset(0, 3).Formula = "=" & strSource & r.Offset(0, 1).Value
        Next r
    End With
End Sub

Code: Select all

Sub Test0()
    Dim rAll As Range
    Dim r As Range, strSource As String
    With Sheets("Sheet1")
        Set rAll = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
        For Each r In rAll
            strSource = "'" & r.Offset(0, -3) & "[" & r.Offset(0, -2) & "]" & _
                r.Offset(0, -1) & "'!"
            r.Offset(0, 2).Formula = "=" & strSource & r.Value
        Next r
    End With
End Sub

Code: Select all

Sub Test()
    Dim MyPath As String
    Dim MyFile As String
    Dim dirName As String
    Dim wks As Worksheet
    
    dirName = "C:\Users\humno\OneDrive\à´Ê¡ì·çÍ»\test\"
    
    MyPath = dirName & "*.xlsx"
    MyFile = Dir(MyPath)
    If MyFile > "" Then MyFile = dirName & MyFile

    Do While MyFile <> ""
        If Len(MyFile) = 0 Then Exit Do
        Workbooks.Open MyFile
        With ActiveWorkbook
            For Each wks In .Worksheets
                wks.Range("A1").Value = "Toye"
                wks.Range("A2").Value = "Boye4"
            Next
        End With
        
        ActiveWorkbook.Close SaveChanges:=True
        MyFile = Dir
        If MyFile > "" Then MyFile = dirName & MyFile
    Loop
End Sub

Code: Select all

Sub Test0()
    Dim rAll As Range
    Dim r As Range, strSource As String
    With Sheets("Sheet1")
        Set rAll = .Range("d2", .Range("d" & .Rows.Count).End(xlUp))
        For Each r In rAll
            strSource = r.Offset(0, -3) & r.Offset(0, -2)
            Workbooks.Open Filename:=(strSource)
            ActiveSheet.Range("A1").Value = Sheet1.Range("F2")
            ActiveWorkbook.Save
            ActiveWorkbook.Close
       Next r
    End With
End Sub

Code: Select all

Dim rAll As Range, tgBook As Workbook
Dim r As Range, strSource As String
Dim d As Object, x() As Variant, i As Integer

Set d = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
    Set rAll = .Range("b2", .Range("b" & .Rows.Count).End(xlUp))
    For Each r In rAll
        strSource = r.Offset(0, -1).Value & r.Value
        If Not d.Exists(strSource) Then
            d.Add Key:=strSource, Item:=strSource
        End If
    Next r
    x = d.keys
    For i = 0 To UBound(x)
        Set tgBook = Workbooks.Open(Filename:=x(i))
        For Each r In rAll
            If tgBook.Name = r.Value Then
                With tgBook.Worksheets(r.Offset(0, 1).Value)
                    .Range(r.Offset(0, 2).Value) = r.Offset(0, 4).Value
                    .Range(r.Offset(0, 3).Value) = r.Offset(0, 5).Value
                End With
            End If
        Next r
        tgBook.Save
        tgBook.Close
    Next i
End With