Import data from Workbook1 to Workbook2 from multiple sheets to multiple sheets

[oyu0217]

Hey peeps, how do I insert a similar process after the first one?

The process is to import from Source workbook1 - sheet1 to Destination workbook2 to sheet1 then next Source workbook1 - sheet2 to Destination workbook2 to sheet2 four more times...

Here's what I have so far...

Sub ImportAllData()

    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
        Application.ScreenUpdating = False

    FileToOpen = Application.GetOpenFilename(Title:="Select the file", FileFilter:="Excel Files (*.xlsm),*.xlsm")
    
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        
        'From Workbook1.Sheet1 to Workbook2.Sheet1
        OpenBook.Sheets(1).Select
        Range("A2").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        'To Workbook2 to Sheet1
        Windows("DestinationWorkbook.xlsm").Activate
        Sheets("Question Form Data").Select
        Range("QuestionTable[[#Headers],['#]]").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Range("QuestionTable[[#Headers],['#]]").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveSheet.Range("QuestionTable[#All]").RemoveDuplicates Columns:=Array(1, 2, _
            3, 4, 5), Header:=xlYes
        
        'Insert next step
        'There's an error in this partI tried NEXT, THEN, CALL but not sure what is the appropriate command to do the next

        'From Workbook1 to Sheet2 to Workbook2.Sheet2
        OpenBook.Select
        OpenBook.Sheets(3).Select
        Range("A2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        'To Workbook2.Sheet2
        Windows("LeadershipTracker_2022 POC test .1.xlsm").Activate
        Sheets("DSAT callback form data").Select
        Range("DSATcallbackTable[[#Headers],['#]]").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Range("DSATcallbackTable[[#Headers],['#]]").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveSheet.Range("DSATcallbackTable[#All]").RemoveDuplicates Columns:=Array( _
            1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11), Header:=xlYes
        
        'Insert FOUR MORE or FIVE same process

        'ActiveWorkbook.Save
        OpenBook.Close False


    End If
        Application.ScreenUpdating = True
End Sub

 

[oyu0217]

All good now. Loop is the key (A friend of mine helped me on this)

 

[smozgur]

Glad to hear you got the solution.

If you would like to post the solution then it is perfectly fine to mark your post as the solution to help future readers. Otherwise, please do not mark a post that doesn't contain a solution.

 

[oyu0217]

Glad to hear you got the solution.

If you would like to post the solution then it is perfectly fine to mark your post as the solution to help future readers. Otherwise, please do not mark a post that doesn't contain a solution.

Its still in progress ?