Link to home
Start Free TrialLog in
Avatar of Luis Diaz
Luis DiazFlag for Colombia

asked on

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
Avatar of Rgonzo1971
Rgonzo1971

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
Avatar of Luis Diaz

ASKER

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.
ASKER CERTIFIED SOLUTION
Avatar of Rgonzo1971
Rgonzo1971

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Tested and it works! Thank you very much for your help.