Import from a Number of Worksheets Listed in a Column

[dj44]

Hi folks,

Good Tuesday all

I have a import data issue that Im trying to solve.


Get Data.jpg


I have put the code togther from other code I had.

I'm afraid its gone a bit pear shaped.

 
    Dim i            As Long
    Dim ws           As Worksheet
    Dim oSourceWorksheet    As Worksheet
    Dim oImportToWorksheet   As Worksheet
    Dim strDir As String
   
   
    Set ws = Worksheets("ImportList")
 
    For i = 3 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
 
        Set oSourceWorksheet = Worksheets(ws.Cells(i, "A").Value)
 
        Set oImportToWorksheet = Application.ActiveWorkbook.Path & Worksheets(ws.Cells(i, "C").Value)
 
        oSourceWorksheet.Range(ws.Cells(i, "C")).Copy Destination:=oImportToWorksheet.Range(ws.Cells(i, "E").Value)
 
      Next i
 
End Sub

I saw Mr Bruins work, but that copied from 1 worksheet
http://www.rondebruin.nl/win/s3/win001.htm

The reason I need to do it this way is because It has formatting and other bits and bobs like hyperlinks, so if I don’t paste it in - I can import only the raw data and I will lose the good bits.

Is my code on the right track?

Thank you for your advice and time

[mancubus]

since destination workbook is not stated i assumed it's the current workbook which the following code will be copied.

test with a copy of the original file.

Sub vbax_57724_import_from_listed_worksheets()

    Dim ImpList
    Dim i As Long
    Dim CopyRng As Range
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .AskToUpdateLinks = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    With ThisWorkbook.Worksheets("ImportList")
        With .Cells(1).CurrentRegion
            ImpList = .Offset(2).Resize(.Rows.Count - 2).Value
        End With
    End With
    
    For i = LBound(ImpList, 1) To UBound(ImpList, 1)
        Workbooks.Open ImpList(i, 1)
        With ActiveWorkbook
            Set CopyRng = .Worksheets(ImpList(i, 2)).Range(ImpList(i, 3))
            ThisWorkbook.Worksheets(ImpList(i, 4)).Range(ImpList(i, 5)).Resize(CopyRng.Rows.Count, CopyRng.Columns.Count).Value = CopyRng.Value
            .Close False
        End With
    Next i

    With Application
        .AskToUpdateLinks = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

[dj44]

Thank you Mancubus

This is an epic line, I will have to get my study glasses on for this

ThisWorkbook.Worksheets(ImpList(i, 4)).Range(ImpList(i, 5)).Resize(CopyRng.Rows.Count, CopyRng.Columns.Count).Value = CopyRng.Value


It did the job

Thank you for helping

Have a good day !

[mancubus]

you are welcome

it's a good practice to prepare a guide especially when dealing with complex projects.

i personally dont use merged cells and 2 header lines, btw.