код для получения данных из другого листа выбора рабочей книги

Question

Мне нужно скопировать и вставить данные из нескольких рабочих книг и нескольких листов.(имя продолжает меняться как на рабочих листах, так и на рабочих)

У меня есть код, но здесь мне нужно вручную выбрать ячейки.Я просто хочу выбрать лист, и он должен автоматически импортировать все данные на листе в назначенный лист в моей книге.Это возможно?

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

Answer 1

Вы можете использовать «исходный» диапазон, чтобы получить его Parent лист UsedRange следующим образом:

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

Answer 2

Вот простой пример того, как вы можете копировать данные с одного на другое.Дайте мне знать, если вам нужна помощь по чему-то более конкретному.

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