使用重新读取单元格将所选数据从一个工作簿复制到另一个工作簿

时间:2016-07-19 11:13:15

标签: excel-vba vba excel

伙计我需要一些有趣的vba命令的帮助。  我有两个电子表格,第一个labownik-mil-2dl8.xls和第二个zestawienie.xls,我想在第一个中选择一些行复制到第二个但不是A1到A1。因此,如果我的选择是从5270到5273的行,我想得到例如E5272到D7和AK5272到E7,依此类推。如果可以通过第二个电子表格中的按钮按下来完成(首先只是在第一个电子表格中进行选择),那就太好了。 Makro应该粘贴到第二个电子表格中的第一个空行。 我有这样的事情:

Sub Get_Data()
    Dim lastrowDB As Long, lastrow As Long
    Dim arr1, arr2, i As Integer

    With Sheets("zestawienie")
        lastrowDB = .Cells(.Rows.Count, "D").End(xlUp).Row + 1
    End With

    arr1 = Array("E", "AK", "B", "D", "F", "G", "H")
    arr2 = Array("D", "E", "F", "H", "L", "M", "N")

    For i = LBound(arr1) To UBound(arr1)
        With Sheets("Labownik")
            lastrow = Application.Max(3, .Cells(.Rows.Count, arr1(i)).End(xlUp).Row)
            .Range(.Cells(3, arr1(i)), .Cells(lastrow, arr1(i))).Copy
            Sheets("zestawienie").Range(arr2(i) & lastrowDB).PasteSpecial xlPasteValues
        End With
    Next
    Application.CutCopyMode = False
End Sub

但它只在两个工作表都在一个文件中时才有效,并且makro正在复制整个数据而不是选择。我不知道如何正确地做到这一点  如果难以阅读,我很抱歉,但英语不是我的母语。

提前谢谢

2 个答案:

答案 0 :(得分:1)

您必须添加一个工作簿对象,以便它知道如何使用这两个工作簿。您的代码将它们视为同一工作簿中的工作表。

Dim wbSecond as Workbook

Set wbSecond = Workbook.Open(parameters)

这将允许您现在在wbSecond引用一个工作簿,并且您始终可以引用您作为MyWorkbook的工作簿。

然后你可以使用语法:

MyWorkbook.Sheets(sheet_name).cells(row,col) = wbSecond.Sheets(sheet_name).cells(row, col)

答案 1 :(得分:0)

一种方法可以是Application.Intersect

Dim rngFrom As Range, rngTo As Range, index As Long

Set rngTo = Workbooks("zestawienie.xls").Sheets("Arkusz1").Range("D7,E7,F7,H7,L7,M7,N7") ' the columns "D", "E", "F", "H", "L", "M", "N" on row 7

Set rngFrom = Workbooks("labownik-mil-2dl8.xls").Sheets("Labownik - 2SLU").Range("E:E,AK:AK,B:B,D:D,F:F,G:G,H:H") ' the columns "E", "AK", "B", "D", "F", "G", "H"

Set rngFrom = Application.Intersect( rngFrom, rngFrom.Worksheet.Range("5270:5273") ) ' the columns "E", "AK", "B", "D", "F", "G", "H" intersected with rows from 5270 to 5273 gives the ranges E5270:E5273,AK5270:AK5273,B5270:B5273,D5270:D5273,F5270:F5273,G5270:G5273,H5270:H5273

For index = 1 To rngTo.Areas.Count 

    rngFrom.Areas(index).Copy
    rngTo.Areas(index).PasteSpecial xlPasteValues

Next 
相关问题