Import data in a selected range from multiples workbooks to the main workbooks.

[Mr Ruf]

Hello everyone! could someone help me please I need to import the range data of all the selected files. The size range (4,1) and information is the same in all files and I need to import them to the main workbook where the range(4,1) information should be in the form (1,4) in each row of the main workbook . The data to import is:

I know that the line which is not working is A(i, j) = Awb.Sheets(1).Range(ImportRange).Cells(i, j) and maybe this Twb.Sheets("Data").Range("A&1:A4") = A(i, j)

Sub RalphieReactor()
Dim Filenames() As Variant, i As Integer, A() As Variant, j As Integer, nw As Integer
Dim Twb As Workbook, Awb As Workbook, UserRange As Range, ImportRange As String
Set Twb = ThisWorkbook
Filenames = Application.GetOpenFilename(Title:="Open File(s)", MultiSelect:=True)
nw = UBound(Filenames)
For i = 1 To nw
    Workbooks.Open Filenames(i)
    Set Awb = ActiveWorkbook
    Set UserRange = Application.InputBox(Prompt:="Range", Type:=8)
    ImportRange = UserRange.Address
    For j = 1 To 4
    ReDim A(1, 4)
    A(i, j) = Awb.Sheets(1).Range(ImportRange).Cells(i, j)
    Twb.Activate
    Twb.Sheets("Data").Range("A&1:A4") = A(i, j)
    Awb.Close SaveChanges:=False
   Next j
Next i
End Sub

 

[sijpie]

When you want to read a range into a variant, then don't try to do it cell by cell, that does away with the advantage of the ultra quick read into an array.

THere are two other things that don't seem to be right:
Is the data area to be read different in each workbook? If not, then don't ask for the address every time in the loop, just do it once.
You are overwriting the output each time, not dropping down to the next row.

    ...
dim lR as long ' to hold the next row to add the data
lR=Twb.Sheets("Data").Range("A" & twb.Sheets(1).rows.count).End(xlUp).Row +1 
For i = 1 To nw
    Workbooks.Open Filenames(i)
    Set Awb = ActiveWorkbook
    if Userrange is Nothing then
        Set UserRange = Application.InputBox(Prompt:="Range", Type:=8)
        ImportRange = UserRange.Address
    end if

    A = Awb.Sheets(1).Range(ImportRange).Value
    ' Twb.Activate  'no need to activate the workbook. It just takes extra time
    ' Now add the copied range (held in A) in rows each below the next. So the array needs to be transposed (from vertical to horizontal)
    Twb.Sheets("Data").Range("A" & lR).Resize(1,4).Value = Application.WorksheetFunction.Transpose(A)
    Awb.Close SaveChanges:=False
    lR=lR + 1
Next i

 

[Mr Ruf]

Thank you very much, this is how it works for me:

Sub RalphieReactor()
Dim Filenames() As Variant, i As Integer, A() As Variant, nw As Integer
Dim Twb As Workbook, Awb As Workbook, UserRange As Range, ImportRange As String
Dim lR As Long
Set Twb = ThisWorkbook
Filenames = Application.GetOpenFilename(Title:="Open File(s)", MultiSelect:=True)
nw = UBound(Filenames)
For i = 1 To nw
    Workbooks.Open Filenames(i)
    Set Awb = ActiveWorkbook
    If UserRange Is Nothing Then
        Set UserRange = Application.InputBox(Prompt:="Range", Type:=8)
        ImportRange = UserRange.Address
    End If
    A = Awb.Sheets(1).Range(ImportRange).Value
    lR = lR + 1
    Awb.Close SaveChanges:=False
    Twb.Sheets("Data").Range("A" & lR).Resize(1, 4).Value = Application.WorksheetFunction.Transpose(A)
     Application.ScreenUpdating = False
Next i
    Columns("A:A").Select
    Selection.NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
    Columns("D:D").Select
    Selection.Style = "Percent"
    Selection.NumberFormat = "0.00%"
End Sub

Just for curiosity, do u know some form to copy the format cell without doing it after the For Loop?