Necesito copiar y pegar datos de varios libros de trabajo y varias hojas. (el nombre cambia constantemente de las hojas de trabajo y del libro de trabajo)

Tengo un código pero aquí necesito seleccionar manualmente las celdas. Solo quiero seleccionar la hoja y debería importar automáticamente todos los datos de la hoja a una hoja de trabajo designada en mi libro de trabajo. ¿Es eso posible?

Sub ImportDatafromotherworksheet()
    Dim wkbCrntWorkBook As Workbook
    Dim wkbSourceBook As Workbook
    Dim rngSourceRange As Range
    Dim rngDestination As Range
    Set wkbCrntWorkBook = ActiveWorkbook
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set wkbSourceBook = ActiveWorkbook
            Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="A1", Type:=8)
            wkbCrntWorkBook.Activate
            Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="A1", Type:=8)
            rngSourceRange.Copy rngDestination
            rngDestination.CurrentRegion.EntireColumn.AutoFit
            wkbSourceBook.Close False
        End If
    End With
End Sub
2
Debrup Dutta 16 oct. 2018 a las 21:43

2 respuestas

La mejor respuesta

Puede usar el rango de "fuente" para obtener su Parent hoja UsedRange, de la siguiente manera:

Sub ImportDatafromotherworksheet()
    Dim wkbCrntWorkBook As Workbook
    Dim rngSourceRange As Range
    Dim rngDestination As Range

    Set wkbCrntWorkBook = ActiveWorkbook
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            With Workbooks.Open(.SelectedItems(1)) ' open and reference current selected "source" workbook
                Set rngSourceRange = Application.InputBox(prompt:="Select any cell in the wanted sheet ", Title:="Source sheet chosing", Default:="A1", Type:=8) ' have user select any cell in source sheet
                If Not rngSourceRange Is Nothing Then ' if any valid "source" range selected
                    wkbCrntWorkBook.Activate ' this could be omitted since subsequent InputBox allowa user to switch between open workbooks
                    Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="A1", Type:=8) ' have user select "destination" cell
                    If Not rngDestination Is Nothing Then ' if any valid "destination" range selected
                        rngSourceRange.Parent.UsedRange.Copy rngDestination.Cells(1, 1) ' be sure to collapse "destination" range to a single cell
                        rngDestination.CurrentRegion.EntireColumn.AutoFit
                    End If
                End If
                .Close False ' close referenced (i.e. current "source" sheet) sheet
            End With
        End If
    End With
End Sub
0
DisplayName 17 oct. 2018 a las 06:50

Aquí hay un ejemplo simple de cómo puede copiar de uno a otro. Avíseme si necesita ayuda con algo más específico.

Sub testing()

    Dim des_wb As Workbook, sou_wb As Workbook
    Dim des_ws As Worksheet
    Dim sou_rng As Range

    ChDir (ActiveWorkbook.Path)
    Set des_wb = ActiveWorkbook

    Set sou_wb = Workbooks.Open(Application.GetOpenFilename)
    Set sou_ws = sou_wb.Worksheets(1)

    Set sou_rng = sou_ws.Range("A1").CurrentRegion

    sou_rng.Copy
    des_wb.Worksheets(1).Range("A1").PasteSpecial

End Sub
1
Mike - SMT 16 oct. 2018 a las 19:16