Ask User what Row to Start Selection At

[rcb007]

I have been playing around with this code. I am trying to figure a way once the macro is run, that it prompts the user for a starting row. Then, it completes the rest of the macro.

The macro will allow the user to select a xlsm and copy columns out of the opened worksheet and paste them into the workbook that the command started from.

The designated pasting areas would not change. But sometime the selection starting rows change. Usually, they are at Row 20, but it does change more frequently. As for the ending or how far to copy from the top to the bottom is 180 Rows.

Sub Import_WB()
Dim WS As Worksheet
Dim wb3 As Workbook, wb4 As Workbook
Dim vFile As Variant

    Application.ScreenUpdating = False

    'Set source workbook
    Set wb3 = ActiveWorkbook

    'Open the target workbook
    vFile = Application.GetOpenFilename("Excel-files,*.xls*,", _
                                        1, "Select One File To Open", , False)

    'if the user didn't select a file, exit sub
    If TypeName(vFile) = "Boolean" Then Exit Sub
    
    Set wb4 = Workbooks.Open(vFile)

    'Set selectedworkbook
    Set wb4 = ActiveWorkbook


'''How could I have it prompt the user for what row to start the selection from?

    'Select cells to copy
    wb4.Sheets("Selection_Sheet").Range("D28:M200").Copy

    wb3.Worksheets("Destination_Sheet").Range("D20:M200").PasteSpecial Paste:=xlPasteValues
    
    wb4.Worksheets("Selection_Sheet").Range("X28:Y200").Copy

    wb3.Worksheets("Destination_Sheet").Range("X20:Y200").PasteSpecial Paste:=xlPasteValues
    
    wb4.Worksheets("Selection_Sheet").Range("AE28:AH200").Copy

    wb3.Worksheets("Destination_Sheet").Range("AE20:AH200").PasteSpecial Paste:=xlPasteValues

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

    wb4.Close False

End Sub

I hope this makes sense what i am trying to type and do! Thank you for any pointers and help!

 

[AlphaFrog]

Sub Import_WB()
Dim WS As Worksheet
Dim wb3 As Workbook, wb4 As Workbook
Dim vFile As Variant

    Application.ScreenUpdating = False

    'Set source workbook
    Set wb3 = ActiveWorkbook

    'Open the target workbook
    vFile = Application.GetOpenFilename("Excel-files,*.xls*,", _
                                        1, "Select One File To Open", , False)

    'if the user didn't select a file, exit sub
    If TypeName(vFile) = "Boolean" Then Exit Sub
   
    Set wb4 = Workbooks.Open(vFile)

'''How could I have it prompt the user for what row to start the selection from?
    Dim rngStart As Range
    wb4.Sheets("Selection_Sheet").Select
    On Error Resume Next
    Set rngStart = Application.InputBox("Please select the top 'Start' cell to copy.", "Start Cell Select", "D20", Type:=8)
    On Error GoTo 0
   
    If Not rngStart Is Nothing Then
        'Select cells to copy
        wb4.Sheets("Selection_Sheet").Range("D" & rngStart.Row).Resize(180, 10).Copy
        wb3.Worksheets("Destination_Sheet").Range("D20").PasteSpecial Paste:=xlPasteValues
       
        wb4.Worksheets("Selection_Sheet").Range("X" & rngStart.Row).Resize(180, 2).Copy
        wb3.Worksheets("Destination_Sheet").Range("X20").PasteSpecial Paste:=xlPasteValues
       
        wb4.Worksheets("Selection_Sheet").Range("AE" & rngStart.Row).Resize(180, 4).Copy
        wb3.Worksheets("Destination_Sheet").Range("AE20").PasteSpecial Paste:=xlPasteValues
   
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End If
   
    wb4.Close False
   
End Sub

 

[rcb007]

Thank you very much for your help! I think i understand what you have modified. This will definitely be a keeper for other macros!