VBA Excel: Copy worksheet from one workbook to another using PERSONAL.xls

Hello experts,

I would like to set up in my PERSONAL.xls file a macro which covers the following macro.

1-Display an inputbox which says: “From which Range do you want to copy the data related to your ActiveSheet”
If I enter A6 the macro should copy from A6 to the last used range cell. If I don't enter data stop the program and display a message “The range reported is not valid”.
2-If 1 is ok, display an input box: “In which Workbook do you want to paste the copied data ?”
I will need to enter the name of the workbook (with the extension OR NOT). Then if I validate and the workbook reported is not opened stop the program and display an error message ("The workbook reported "" is not opened unable to copy the data"
3-If 2 is ok, display an Input box: “In which Worksheet do you want to copy the data3,
If I don't enter any value and I validate the inputbox, the sheet from which I have made the copy should be added in my destination workbook else If I specified a worksheet check if it exists if so paste the data in A1 if not display an error message the worksheet specified doesn't exist and stop the program
LVL 1
LD16Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
HI,

pls try (in the 1st inputbox you can select the whole range like in excel)

Sub macro()

Set OrigSh = ActiveSheet

On Error Resume Next
Set myRng = Application.InputBox("Select your range", " Range of origin", Type:=8)
On Error GoTo 0
If IsEmpty(myRng) Then
    MsgBox "The range reported is not valid"
    Exit Sub
End If
Dim fd As Office.FileDialog

Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd

    .AllowMultiSelect = False
    .Title = "Please select the file"
    .Filters.Add "Excel", "*.xls"
    .Filters.Add "All", "*.*"

    If .Show = True Then
        txtFileName = .SelectedItems(1)
    End If

End With
If txtFileName = "" Then
    MsgBox "No Workbook selected"
    Exit Sub
End If
On Error Resume Next
Set XlFile = Workbooks.Open(txtFileName)
On Error GoTo 0
If IsEmpty(XlFile) Then
    MsgBox "The workbook reported " & txtFileName & " is not opened unable to copy the data"
    Exit Sub
End If

strSh = Application.InputBox("Select your sheet", " Range of origin")
If strSh = "" Then
    OrigSh.Copy after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ElseIf strSh = False Then
    MsgBox " No sheet selected"
    Exit Sub
Else
    If Evaluate("=isref('" & strSh & "'!A1)") Then
        myRng.Copy ActiveWorkbook.Sheets(strSh).Range("A1")
    Else
        MsgBox "Sheet: " & strSh & " not valid"
    End If
End If
Set myRng = Nothing
Set XlFile = Nothing
End Sub

Open in new window

Regards
0
LD16Author Commented:
Thank you very much for this code.

I tested and I was wondering if:

1-For inputbox 1 is there a way to just select the start range and then the macro should take into account the last used range, Ex: I have a A2:C16200, instead of make the selection of the whole I would like just to select the start range “A2” and then the macro should automatically take into account the last used range C:16200.

2-Between inputbox 1 and 2 is there a way to add an inputbox whih the following information:
Workbook to paste your copied data is alreay opened. If so, we going through the inputbox: Report your workbook open in which you want to copy the data and then last inputbox: report your sheet.
If I reply no to the inputbox between 1 and 2 “Workbook to paste your copied data is alreay opened? in that case we use the Application.FileDialog(msoFileDialogFilePicker) in order to open the file and we continue by selecting the sheet in which we want to copy the data as it is done now.

3-Clear Format of the sheet in which I have paste my selection.

Thank you very much for your help.
0
Rgonzo1971Commented:
then try

Sub macro()

Set OrigSh = ActiveSheet

On Error Resume Next
Set myRng = Application.InputBox("Select your first cell", "Cell of origin", Type:=8)
On Error GoTo 0
If myRng Is Nothing Then
    MsgBox "The range reported is not valid"
    Exit Sub
End If
Set myRng = Range(myRng, myRng.SpecialCells(xlCellTypeLastCell))
res = MsgBox("Is your Destination File opened?", vbYesNo)
If res = vbYes Then
    strOpenedFile = InputBox("Choose your opened file")
    If strOpenedFile = "" Then
        MsgBox "No Worbook Chose"
        Exit Sub
    Else
        On Error Resume Next
        Set XlFile = Workbooks(strOpenedFile)
        On Error GoTo 0
        If IsEmpty(XlFile) Then
            MsgBox "The workbook reported " & strOpenedFile & " is not opened unable to copy the data"
            Exit Sub
        End If
        XlFile.Activate
    End If
ElseIf res = vbCancel Then
    MsgBox "Operation canceled"
    Exit Sub
Else
    Dim fd As Office.FileDialog
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    With fd
    
        .AllowMultiSelect = False
        .Title = "Please select the file to kill his non colored cells"
        .Filters.Add "Excel", "*.xls"
        .Filters.Add "All", "*.*"
    
        If .Show = True Then
            txtFileName = .SelectedItems(1)
        End If
    
    End With
    If txtFileName = "" Then
        MsgBox "No Workbook selected"
        Exit Sub
    End If
    On Error Resume Next
    Set XlFile = Workbooks.Open(txtFileName)
    On Error GoTo 0
    If IsEmpty(XlFile) Then
        MsgBox "The workbook reported " & txtFileName & " is not opened unable to copy the data"
        Exit Sub
    End If
End If




strSh = Application.InputBox("Select your sheet", " Range of origin")
If strSh = "" Then
    OrigSh.Copy after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ElseIf strSh = False Then
    MsgBox " No sheet selected"
    Exit Sub
Else
    If Evaluate("=isref('" & strSh & "'!A1)") Then
        ActiveWorkbook.Sheets(strSh).Cells.ClearContents
        myRng.Copy ActiveWorkbook.Sheets(strSh).Range("A1")
    Else
        MsgBox "Sheet: " & strSh & " not valid"
    End If
End If
Set myRng = Nothing
Set XlFile = Nothing
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
LD16Author Commented:
Tested and it works! Thank you very much for your help.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.