Импорт данных из другой книги VBA - PullRequest
0 голосов
/ 13 июля 2020

Мне нужна помощь, не могу понять, как импортировать только значения с этим кодом

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; *.xls"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set wkbSourceBook = ActiveWorkbook
            Set rngSourceRange = Application.ActiveWorkbook.ActiveSheet.range("A2:C200")
            wkbCrntWorkBook.Activate
            Set rngDestination = Application.ActiveWorkbook.Sheets("DS").range("G17:G17")
            rngSourceRange.Copy rngDestination
            rngDestination.CurrentRegion.EntireColumn.AutoFit
            wkbSourceBook.Close False
            Application.ScreenUpdating = False
        End If
    End With
End Sub

Tnx.

1 Ответ

0 голосов
/ 13 июля 2020

Это должно работать:

Sub ImportDatafromotherworksheet()
    Dim wkbCrntWorkBook As Workbook
    Dim wkbSourceBook As Workbook
    Set wkbCrntWorkBook = ActiveWorkbook 'or ThisWorkbook for file containing this code.
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa; *.xls"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
        
            'Just reference the files - no need to activate them first.
            Set wkbSourceBook = Workbooks.Open(.SelectedItems(1))
            wkbSourceBook.Worksheets("Sheet1").Range("A2:C200").Copy 'Remember to change the sheet name.
            wkbCrntWorkBook.Worksheets("DS").Range("G17").PasteSpecial xlPasteValues
            
            'For a normal Copy/Paste you can use:
            'wkbSourceBook.Worksheets("Sheet1").Range("A2:C200").Copy _
            '    Destination:=wkbCrntWorkBook.Worksheets("DS").Range("G17")
            
            wkbSourceBook.Close False
            
        End If
    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...