Prashant1211
New Member
- Joined
- Jun 9, 2020
- Messages
- 33
- Office Version
- 2016
- Platform
- Windows
Dear All,
I already have below code which imports data from another workbook, but this copies complete range which i dont need. my expectation is as below -
when i select file to import data from
- a Listbox appears which picks unique items from Sheet1.Range("A") of selected file.
- from the unique item list, i can select the required items (multiple items)
- with command button complete rows of items selected gets copied in my other workbook.
if anyone can help me in the code please.
so far i use below code which copies the data and then i manually delete all rows which are not required.
On Error Resume Next
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim LastRow As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen = False Then Exit Sub
Set OpenBook = Application.Workbooks.Open(FileToOpen)
LastRow = ActiveSheet.UsedRange.Rows.Count
OpenBook.Sheets(1).Range("A1:J1" & LastRow).Copy
ThisWorkbook.Worksheets("Main Sheet").Activate
Sheets.Add(After:=Sheets("Main Sheet")).Name = "Sheet1"
Sheets("Sheet1").Select
ActiveSheet.Paste
I already have below code which imports data from another workbook, but this copies complete range which i dont need. my expectation is as below -
when i select file to import data from
- a Listbox appears which picks unique items from Sheet1.Range("A") of selected file.
- from the unique item list, i can select the required items (multiple items)
- with command button complete rows of items selected gets copied in my other workbook.
if anyone can help me in the code please.
so far i use below code which copies the data and then i manually delete all rows which are not required.
On Error Resume Next
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim LastRow As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen = False Then Exit Sub
Set OpenBook = Application.Workbooks.Open(FileToOpen)
LastRow = ActiveSheet.UsedRange.Rows.Count
OpenBook.Sheets(1).Range("A1:J1" & LastRow).Copy
ThisWorkbook.Worksheets("Main Sheet").Activate
Sheets.Add(After:=Sheets("Main Sheet")).Name = "Sheet1"
Sheets("Sheet1").Select
ActiveSheet.Paste