Attempting importing sheet from data file into destination file.

L

LZ_Code

New Member
Joined
Jan 30, 2025
Messages
25
Office Version
  1. 365
Platform
  1. Windows
I am Attempting this code and use it. But for some reason when importing worksheet it uploads the worksheet that is selected by the user when prompted instead of naming the sheet 'Import'. There for cant hide the tab that is imported. Also I am attempting to copy data from 'Import' to new Sheet2, since the data from 'Import' will be different every time. need it to scan and import to selected range in new sheet2

This is original Post
www.mrexcel.com

VBA - Import Workbook/Choose Sheet/Display Details

Hello, This was a follow-on question related to another thread here on the board. At the recommendation of the board (the original question is more than 1400 days old), as well as the original solution giver, I am posting this with some of my own directed details. I am trying to do a mixture...
www.mrexcel.com www.mrexcel.com

VBA Code: 
Option Explicit
Sub ImportData()
    
    Dim OpenBook As Workbook
    Dim TargetFile As String, msg As String, FileName As String, response As String
    Dim lngCount As Long, i As Long, x As Long, counter As Long
    Dim ws As Worksheet

    'Prompts user to select and open a workbook (no screen updating)
    'The open/selected workbook is recorded as being "TargetFile"
    
    'Open the file dialog
    With Application.FileDialog(3) '3 = msoFileDialogOpen
        .AllowMultiSelect = False
        If .Show = -1 Then
            For lngCount = 1 To .SelectedItems.Count
                Set OpenBook = Workbooks.Open(CStr(.SelectedItems(lngCount))) 'Assumes the workbook is not already open
                TargetFile = Dir(CStr(.SelectedItems(lngCount)))
            Next lngCount
        Else
            Exit Sub
        End If
    End With
    
    Application.ScreenUpdating = False
  
    'The following code looks at the newly selected/opened workbook, then prompts the user to choose which worksheet to copy from
    'The information is then copied into the 'Import' tab
    
    msg = "Choose Project BOM to copy from """ & TargetFile & """?"
  
    With Workbooks(TargetFile)
        For i = 1 To .Worksheets.Count
            msg = msg & vbCrLf & "(" & i & ") " & .Worksheets(i).Name
        Next i
        
        response = InputBox(msg, "Type numbers for sheets to import")
  
        If response = "" Then Exit Sub 'check for cancel button
        
        On Error Resume Next
            Set ws = .Worksheets(CLng(response))
            If Err.Number = 0 Then
                ws.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'Copies the chosen worksheet into 'Import' tab
                ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = "Import" 'Name uploads as the worksheet chossen by user not 'Import'
           
            End If
        On Error GoTo 0
    End With
    
    'This routine pastes the path of the chosen/selected file on cell B6 of the 'Status' tab/sheet
    ThisWorkbook.Sheets("PAGE").Range("B2").Value = TargetFile
    
    ThisWorkbook.Sheets("Import").Visible = False

  
    'Closes the chosen workbook file without making any saves or changes (no screen updating)
    Workbooks(TargetFile).Close SaveChanges:=False
    Application.ScreenUpdating = True
  
    'Attempting to copy data that is on 'Import' sheet to new Destination Sheet, rows may differ depending on Import data. Also need to import data but keep destination format
    Sheets("Import").Range("B4:E4").Copy Destination:=Sheets("Sheet2").Range("A13:D13")End(xlUp).Value = .SpecialCells(xlConstants).Value
  
  
End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
Do you just want to delete and replace the Import sheet if it already exists ?
If so just add the code in blue below:

Edit: Just noticed I left in the single quotes and they are not required for a sheet called Import but I will leave them since they don't do any harm and will make it easier should you wish to use a different sheet name.

Rich (BB code): 
        On Error Resume Next
            Set ws = .Worksheets(CLng(response))
            If Err.Number = 0 Then
                ws.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'Copies the chosen worksheet into 'Import' tab
                ' Check if Sheet Import already exists and if so delete it
                If Evaluate("ISREF('" & "Import" & "'!A1)") Then
                    Application.DisplayAlerts = False
                    ThisWorkbook.Worksheets("Import").Delete
                    Application.DisplayAlerts = True
                End If
                ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = "Import" 'Name uploads as the worksheet chossen by user not 'Import'

            End If
        On Error GoTo 0
 
Upvote 0
Alex Blakenburg said:
Do you just want to delete and replace the Import sheet if it already exists ?
If so just add the code in blue below:

Edit: Just noticed I left in the single quotes and they are not required for a sheet called Import but I will leave them since they don't do any harm and will make it easier should you wish to use a different sheet name.

Rich (BB code): 
        On Error Resume Next
            Set ws = .Worksheets(CLng(response))
            If Err.Number = 0 Then
                ws.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'Copies the chosen worksheet into 'Import' tab
                ' Check if Sheet Import already exists and if so delete it
                If Evaluate("ISREF('" & "Import" & "'!A1)") Then
                    Application.DisplayAlerts = False
                    ThisWorkbook.Worksheets("Import").Delete
                    Application.DisplayAlerts = True
                End If
                ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = "Import" 'Name uploads as the worksheet chossen by user not 'Import'

            End If
        On Error GoTo 0
Click to expand...


Tried, But this only deletes the import and now it doesn't copy the data anymore to the destination sheet2.
 
Upvote 0
OK So I got it working perfectly to how I need it. But now I'm stuck in the last part (SEE RED TEXT). I need the code to scan the "Import" sheet, and paste lines that have text in row A. Below is an example of the BOM that I'm importing.

1738353173880.png


VBA Code: 
Option Explicit
Sub ImportData()
    
    Dim OpenBook As Workbook
    Dim TargetFile As String, msg As String, FileName As String, response As String
    Dim lngCount As Long, i As Long, x As Long, counter As Long
    Dim ws As Worksheet

    'Prompts user to select and open a workbook (no screen updating)
    'The open/selected workbook is recorded as being "TargetFile"
    
    'Open the file dialog
    With Application.FileDialog(3) '3 = msoFileDialogOpen
        .AllowMultiSelect = False
        If .Show = -1 Then
            For lngCount = 1 To .SelectedItems.Count
                Set OpenBook = Workbooks.Open(CStr(.SelectedItems(lngCount))) 'Assumes the workbook is not already open
                TargetFile = Dir(CStr(.SelectedItems(lngCount)))
            Next lngCount
        Else
            Exit Sub
        End If
    End With
    
    Application.ScreenUpdating = False
  
    'The following code looks at the newly selected/opened workbook, then prompts the user to choose which worksheet to copy from
    'The information is then copied into the 'Import' tab
    
    msg = "Choose Project BOM to copy from """ & TargetFile & """?"
  
    With Workbooks(TargetFile)
        For i = 1 To .Worksheets.Count
            msg = msg & vbCrLf & "(" & i & ") " & .Worksheets(i).Name
        Next i
        
        response = InputBox(msg, "Type numbers for sheets to import")
  
        If response = "" Then Exit Sub 'check for cancel button
        
        On Error Resume Next
            Set ws = .Worksheets(CLng(response))
            If Err.Number = 0 Then
                ws.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'Copies the chosen worksheet into 'Import' tab
                
                'Check if Sheet Import already exists and if so delete it
                If Evaluate("ISREF('" & "Import" & "'!A1)") Then
                    Application.DisplayAlerts = False
                    ThisWorkbook.Worksheets("Import").Delete
                    Application.DisplayAlerts = True
                End If
                ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = "Import" 'Name uploads as the worksheet chossen by user not 'Import'
       
            End If
        On Error GoTo 0
    End With
    
    'This routine pastes the path of the chosen/selected file on cell B6 of the 'Status' tab/sheet
    'ThisWorkbook.Sheets("PAGE").Range("B2").Value = TargetFile

  
    'Closes the chosen workbook file without making any saves or changes (no screen updating)
    Workbooks(TargetFile).Close SaveChanges:=False
    Application.ScreenUpdating = True
  
    'Attempting to copy data that is on 'Import' sheet to new Destination Sheet


End Sub

[COLOR=rgb(184, 49, 47)]Sub ExtractData()

    Dim sourceSheet As Worksheet
    Dim destinationSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Sheets("Import")
    Set destinationSheet = ThisWorkbook.Sheets("Sheet2")
    
    sourceSheet.Range("B4:E4").Copy
    destinationSheet.Range("A13").PasteSpecial Paste:=xlPasteValues

        If Evaluate("ISREF('" & "Import" & "'!A1)") Then
            Application.DisplayAlerts = False
            ThisWorkbook.Worksheets("Import").Delete
            Application.DisplayAlerts = True
        End If
    
       
End Sub[/COLOR]
 
Upvote 0
See if this does what you need.
Note: since your previous code mentioned Row 4 and your image doesn't show the row and column references, the code looks for "ID" in column A to determine the first row.

VBA Code: 
Sub ExtractData()


    Dim sourceSheet As Worksheet
    Dim destinationSheet As Worksheet
    Dim rowFirst As Long, rowLast As Long
    Dim sourceRng As Range
    
    Set sourceSheet = ThisWorkbook.Sheets("Import")
    Set destinationSheet = ThisWorkbook.Sheets("Sheet2")
    
    With Application
        rowFirst = .IfError(.Match("ID", sourceSheet.Columns("A"), 0), 0)
        If rowFirst = 0 Then Exit Sub
    End With
    
    With sourceSheet
        rowLast = .Cells.Find(What:="*", _
                        After:=.Range("A1"), _
                        LookAt:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        Set sourceRng = .Range(.Cells(rowFirst, "A"), .Cells(rowLast, "E"))
    End With
    
    With sourceRng
        If sourceSheet.FilterMode Then sourceSheet.ShowAllData
        sourceRng.AutoFilter Field:=1, Criteria1:="<>"
        sourceRng.Copy
    End With
    
    
    'destinationSheet.Range("A13").PasteSpecial Paste:=xlPasteValues
    ' Assuming you didn't want A13 hard coded
    With destinationSheet
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        ' Release selection on paste range
        .Activate
        .Range("A1").Select
    End With
    
    sourceRng.AutoFilter
    Application.CutCopyMode = False

    If Evaluate("ISREF('" & "Import" & "'!A1)") Then
        Application.DisplayAlerts = False
        ThisWorkbook.Worksheets("Import").Delete
        Application.DisplayAlerts = True
    End If
    
End Sub
 
Upvote 0
Alex Blakenburg said:
See if this does what you need.
Note: since your previous code mentioned Row 4 and your image doesn't show the row and column references, the code looks for "ID" in column A to determine the first row.

VBA Code: 
Sub ExtractData()


    Dim sourceSheet As Worksheet
    Dim destinationSheet As Worksheet
    Dim rowFirst As Long, rowLast As Long
    Dim sourceRng As Range
   
    Set sourceSheet = ThisWorkbook.Sheets("Import")
    Set destinationSheet = ThisWorkbook.Sheets("Sheet2")
   
    With Application
        rowFirst = .IfError(.Match("ID", sourceSheet.Columns("A"), 0), 0)
        If rowFirst = 0 Then Exit Sub
    End With
   
    With sourceSheet
        rowLast = .Cells.Find(What:="*", _
                        After:=.Range("A1"), _
                        LookAt:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        Set sourceRng = .Range(.Cells(rowFirst, "A"), .Cells(rowLast, "E"))
    End With
   
    With sourceRng
        If sourceSheet.FilterMode Then sourceSheet.ShowAllData
        sourceRng.AutoFilter Field:=1, Criteria1:="<>"
        sourceRng.Copy
    End With
   
   
    'destinationSheet.Range("A13").PasteSpecial Paste:=xlPasteValues
    ' Assuming you didn't want A13 hard coded
    With destinationSheet
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        ' Release selection on paste range
        .Activate
        .Range("A1").Select
    End With
   
    sourceRng.AutoFilter
    Application.CutCopyMode = False

    If Evaluate("ISREF('" & "Import" & "'!A1)") Then
        Application.DisplayAlerts = False
        ThisWorkbook.Worksheets("Import").Delete
        Application.DisplayAlerts = True
    End If
   
End Sub
Click to expand...
here's a snapshot on Sheet2.
1738599767425.png


The code gets stuck on this line not sure what to do. Im stuck. It doe not give an error. tried stepping into it. But it just stops.
1738599808333.png
 
Upvote 0
That code assumes you have run the previous code in Import data. Have you run that ?
Also give me the same screenshot for the sheet called "Import".
 
Upvote 0
Alex Blakenburg said:
That code assumes you have run the previous code in Import data. Have you run that ?
Also give me the same screenshot for the sheet called "Import".
Click to expand...
Yes, multiple times. But it just stops at importing the 'Import' sheet. Does not continue the Extraction code. Heres the BOM screen shot. It changes based on project

1738601015983.png
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Locked
  • Question Question
VBA to copy only matching data from 2 csv workbooks into the "Master Workbook"
Replies
1
Views
380
RoryA
RoryA
D
  • Solved
VBA to copy only matching data from 2 csv workbooks into the "MasterCSV"
2
Replies
18
Views
1K
Peter_SSs
Peter_SSs
B
  • Solved
Better Way to Copy Rows Out of a Loop?
2
Replies
11
Views
324
dmt32
D
D
  • Question Question
Importing data from another spreadsheet as a value
Replies
1
Views
117
Eric W
Eric W
T
  • Solved
CSV import overwriting the next column after the last one in the CSV file
Replies
7
Views
422
Joe4
Joe4

Forum statistics

Threads
1,226,516
Messages
6,191,500
Members
453,660
Latest member
Wp1902

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top