Attempting importing sheet from data file into destination file.

[LZ_Code]

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

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

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

 

[Alex Blakenburg]

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.

        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

 

[LZ_Code]

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.

        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

Tried, But this only deletes the import and now it doesn't copy the data anymore to the destination sheet2.

 

[LZ_Code]

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.

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]

 

[Alex Blakenburg]

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.

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