VBA filepicker working with two files

[henrik2h]

Hi, I am trying to write a macro that would take data from one source file (wbS) and put into another file (wbT). The macro I would prefer to keep outside these files, in a separate file.

I tried to search for how to set it up with filepicker but need help getting started.
The source file will hold both the data and the destination sheet and cell (these are always the same) where to put it in the target file.
Like this:

10	Sheet1!B10
20	Sheet1!C13
30	Sheet1!D22

So, pick a file as source (wbS), pick a file as target (wbT), place the number 10 in wbTSheet1!B10, then place 20 in wbTSheet1!C13 and so on.

My thinking is I will first read everything from the source file (continuous range) into an array and then place line by line into the target.

Any pointers?

 

[henrik2h]

Think I got it to work myself, probably room for improvement...

Option Base 1
Sub TransferDataBetweenFiles()

' Source file has a sheet named "DATA" with a table named "tbDATA"
' First column in table will hold value to be transferred
' Second column in table hold sheet name in target file
' Third column in table hold range (cell) in target file
' Target file has a number of places (a report) where different data points should go
' The real pain in the a$$ is defining all datapoints/cells that should go into the report

    Dim SourceFilePath As String, TargetFilePath As String, arrDATA() As Variant, j As Variant
    Dim wbSOURCE As Workbook, wbTARGET As Workbook, datarows As Integer, i As Integer
    
    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show <> 0 Then
            SourceFilePath = .SelectedItems(1)
        End If
        If .Show <> 0 Then
            TargetFilePath = .SelectedItems(1)
        End If
    End With

    Workbooks.Open (SourceFilePath)
    Set wbSOURCE = ActiveWorkbook
    arrDATA = wbSOURCE.Sheets("DATA").ListObjects("tbDATA").DataBodyRange.Value
    datarows = wbSOURCE.Sheets("DATA").ListObjects("tbDATA").DataBodyRange.rows.Count
    wbSOURCE.Close


    Workbooks.Open (TargetFilePath)
    Set wbTARGET = ActiveWorkbook
    For i = 1 To datarows
    
        If wbTARGET.Sheets(arrDATA(i, 2)).Range(arrDATA(i, 3)).Locked = True Then
        MsgBox "Error in path, row " & i, vbOKOnly
        wbTARGET.Close savechanges:=False
        Exit Sub
        End If
    
    wbTARGET.Sheets(arrDATA(i, 2)).Range(arrDATA(i, 3)) = arrDATA(i, 1)
    Next i
    
    wbTARGET.Close savechanges:=True

'Debug.Print SourceFilePath
'Debug.Print TargetFilePath
'For Each j In arrDATA

 '   Debug.Print j

'Next

End Sub

 

[Domenic]

I haven't tested it fully, but I think your macro can be re-written as follows...

Option Explicit
Option Base 1

Sub TransferDataBetweenFiles()

' Source file has a sheet named "DATA" with a table named "tbDATA"
' First column in table will hold value to be transferred
' Second column in table hold sheet name in target file
' Third column in table hold range (cell) in target file
' Target file has a number of places (a report) where different data points should go
' The real pain in the a$$ is defining all datapoints/cells that should go into the report

    Dim SourceFilePath As String, TargetFilePath As String, arrDATA() As Variant
    Dim wbSOURCE As Workbook, wbTARGET As Workbook, i As Long
  
    With Application.FileDialog(msoFileDialogFilePicker)
        .ButtonName = "Select"
        With .Filters
            .Clear
            .Add "Excel Files", "*.xlsx" 'or "*.xlsx;*.xlsm"
        End With
        .InitialFileName = Application.DefaultFilePath & "\" 'change as desired
        .Title = "Select an Excel file"
        If .Show = 0 Then Exit Sub
        SourceFilePath = .SelectedItems(1)
        If .Show = 0 Then Exit Sub
        TargetFilePath = .SelectedItems(1)
    End With

    Set wbSOURCE = Workbooks.Open(SourceFilePath)
  
    arrDATA = wbSOURCE.Sheets("DATA").ListObjects("tbDATA").DataBodyRange.Value
  
    wbSOURCE.Close

    Set wbTARGET = Workbooks.Open(TargetFilePath)
  
    For i = LBound(arrDATA, 1) To UBound(arrDATA, 1)
  
        If wbTARGET.Sheets(arrDATA(i, 2)).Range(arrDATA(i, 3)).Locked = True Then
            MsgBox "Error in path, row " & i, vbOKOnly
            wbTARGET.Close savechanges:=False
            Exit Sub
        End If
  
        wbTARGET.Sheets(arrDATA(i, 2)).Range(arrDATA(i, 3)) = arrDATA(i, 1)
      
    Next i
  
    wbTARGET.Close savechanges:=True

End Sub

Note that I don't think you need Option Base 1, since arrDATA will automatically be assigned a one-based array.

If you have any questions, don't hesitate to ask.

Cheers!