What is most efficient way to extract values from multiple non-contiguous cells from one workbook an-CodePudding

Little background, I am very new to VBA and just cant seem to find a solution to my problem. I am using this project as a means of learning basic VBA principles. Please bare with me.

I am currently attempting to write a macro that pulls values from non-contiguous cells (IE: F9, E15, G17, etc..) from a specific workbook and then pastes them into a table in a primary workbook. Each cell has data that needs to be added to a specific column in said table. I have hundreds of different files with the exact same layout (same important cell locations) that I want to eventually cycle through and add to a master table on the primary workbook. I would like to automate it.

My problem lies in not knowing the best method do go about this. I only need information from 12 cells per file so it is not an intense transfer. I have attempted going about it through arrays, creating variables, and messing with ranges. I was able to get to the point where I create a different variable for each cell I want data from and then, one-by-one, insert them into a specific cell in the primary workbook. This is far from automatic and doesn't include inserting each value under a specific column in my table.

Here is the most functional macro I've been able to create. It seems clunky and inefficient and does not prove to be a solution for my primary problems: automation, efficiency.

Sub data_pull()

Dim x As Workbook
Dim y As Workbook

Application.ScreenUpdating = False

Set x = Workbooks.Open("C:\Users\ - workbook that data is pulled from")
Set y = Workbooks.Open("C:\Users\ - workbook that data is put to")

'Pulling data through variables
RSS = x.Sheets(1).Range("F9").Value
RSE1_F = x.Sheets(1).Range("E13").Value
RSE1_B = x.Sheets(1).Range("F13").Value
RSE2_F = x.Sheets(1).Range("E14").Value
RSE2_B = x.Sheets(1).Range("F14").Value
TI = x.Sheets(1).Range("F20").Value
SI = x.Sheets(1).Range("F30").Value
FIBI = Split(x.Sheets(1).Range("F36").Value, "/") 'Cell has two values separated by a "/"
PEN = x.Sheets(1).Range("E40").Value

'Putting data through predefined variables
y.Sheets(1).Range("A1").Value = RSS
y.Sheets(1).Range("B1").Value = RSE1_F
y.Sheets(1).Range("C1").Value = RSE1_B
y.Sheets(1).Range("D1").Value = RSE2_F
y.Sheets(1).Range("E1").Value = RSE2_B
y.Sheets(1).Range("F1").Value = TI
y.Sheets(1).Range("G1").Value = SI
y.Sheets(1).Range("H1").Value = FIBI(0)     
y.Sheets(1).Range("I1").Value = FIBI(1)     
y.Sheets(1).Range("J1").Value = PEN

x.Close

Application.ScreenUpdating = True

End Sub

As you can see it is completely handled by calling for specific cell locations and does not append any data to a table specifically. I have a hunch that I could define a range with each cell location and then loop through that range, appending each cell to the desired table location.

Any and all feedback is greatly appreciated. If any more info is needed I am more than happy to elaborate!

Thanks!

CodePudding user response：

One option for collecting cell values from a non-contiguous range is by defining the whole range, copying into an array and pasting in your uniform output region:

Option Explicit
Sub General_Testing()
        
    ' > Var
    Dim wsInput As Worksheet
    Dim wsOutput As Worksheet
    Dim RG As Range
    Dim CL As Range
    Dim RGarr
    Dim I As Long
    
    ' > Change to your workbooks/Sheets
    Set wsInput = ThisWorkbook.Worksheets(1)
    Set wsOutput = ThisWorkbook.Worksheets(2)
    
    ' > Source Data range
    Set RG = wsInput.Range("$F$6,$E$13:$F$14,$F$20:$F$21")
    ReDim RGarr(1 To RG.Cells.Count)
    
    ' > Move into array
    I = 1
    For Each CL In RG.Cells
        RGarr(I) = CL.Value
        I = I   1
    Next CL
    
    With wsOutput
        ' > Array to output range
        .Range("A1").Resize(1, UBound(RGarr)) = RGarr
        
        ' > last couple oddball values
        .Range("H1:I1").Value = Split(wsInput.Range("F36"), "/")
        .Range("J1").Value = wsInput.Range("F40").Value
    End With
    
End Sub

If you want, you could easily do the whole thing including your split cell in the one array, just check for delimiter and increment I twice.

This is what is looks like:

Input:

Output:

Method 2:

Option Explicit
Sub General_Testing()
        
    ' > Var
    Dim wsInput As Worksheet
    Dim wsOutput As Worksheet
    Dim RG As Range
    Dim CL As Range
    Dim RGarr
    Dim I As Long
    
    ' > Change to your workbooks/Sheets
    Set wsInput = ThisWorkbook.Worksheets(1)
    Set wsOutput = ThisWorkbook.Worksheets(2)
    
    ' > Source Data range
    Set RG = wsInput.Range("$F$6,$E$13:$F$14,$F$20:$F$21,$F$36,$E$40")
    ReDim RGarr(1 To RG.Cells.Count)
    
    ' > Move into array
    I = 1
    For Each CL In RG.Cells
        If InStr(1, CL.Value, "/") > 0 Then
            ' > String must be split
            ReDim Preserve RGarr(1 To UBound(RGarr)   1)
            RGarr(I) = Split(CL.Value, "/")(0)
            I = I   1
            RGarr(I) = Split(CL.Value, "/")(1)
            I = I   1
        Else
            ' > String must not be split
            RGarr(I) = CL.Value
            I = I   1
        End If
    Next CL
    
    With wsOutput
        ' > Array to output range
        .Range("A1").Resize(1, UBound(RGarr)) = RGarr
    End With
    
End Sub