范围合并在VBA中复制和粘贴

时间:2019-11-18 14:12:52

标签: excel vba

我最近在将范围的联合从一个工作表复制到另一个工作表时遇到了问题。问题是,即使我只是尝试选择结尾的工作簿,也无法这样做。联合仅包含1个WS范围。我复制了所有这些文件,但是当我尝试移动到默认工作簿时,它以某种方式无法到达那里。

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Application.DisplayStatusBar = False
Application.DisplayAlerts = False

Set DestWbk = ThisWorkbook


fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File", MultiSelect:=True)

If VarType(fname) = vbBoolean Then Exit Sub

    r = 1

   For i = 1 To UBound(Fname)
       For Each file In fname

           Set SrcWbk = Workbooks.Open(file, UpdateLinks:=False)

           Target = "blablabla1"
           MsgBox ("target decalered")
           cname = "blablabla2"
           repay = "blablabla3"
           isin = "blablabla4"
           ogn= "blablabla5"
           qlt = "blablabla6"
           cnamecol = SrcWbk.ActiveSheet.Cells.Find(What:=cname, LookIn:=xlValues).Column
           Targetrow = SrcWbk.ActiveSheet.Cells.Find(What:=Target, LookIn:=xlValues).Row
           targetcol = SrcWbk.ActiveSheet.Cells.Find(What:=Target, LookIn:=xlValues).Column
           repaycol = SrcWbk.ActiveSheet.Cells.Find(What:=repay, LookIn:=xlValues).Column
           isincol = SrcWbk.ActiveSheet.Cells.Find(What:=isin, LookIn:=xlValues).Column
           ogncol = SrcWbk.ActiveSheet.Cells.Find(What:=ogn, LookIn:=xlValues).Column
           qltcol = SrcWbk.ActiveSheet.Cells.Find(What:=qlt, LookIn:=xlValues).Column

           k = SrcWbk.ActiveSheet.Cells(1048576, targetcol).End(xlUp).Row
           MsgBox (k)

           Set range1 = SrcWbk.ActiveSheet.Range(SrcWbk.ActiveSheet.Cells(Targetrow, targetcol), SrcWbk.ActiveSheet.Cells(k, targetcol))
           Set range2 = SrcWbk.ActiveSheet.Range(SrcWbk.ActiveSheet.Cells(Targetrow, cnamecol), SrcWbk.ActiveSheet.Cells(k, cnamecol))
           Set range3 = SrcWbk.ActiveSheet.Range(SrcWbk.ActiveSheet.Cells(Targetrow, repaycol), SrcWbk.ActiveSheet.Cells(k, repaycol))
           Set range4 = SrcWbk.ActiveSheet.Range(SrcWbk.ActiveSheet.Cells(Targetrow, isincol), SrcWbk.ActiveSheet.Cells(k, isincol))
           Set range5 = SrcWbk.ActiveSheet.Range(SrcWbk.ActiveSheet.Cells(Targetrow, ogncol), SrcWbk.ActiveSheet.Cells(k, ogncol))
           Set range6 = SrcWbk.ActiveSheet.Range(SrcWbk.ActiveSheet.Cells(Targetrow, qltcol), SrcWbk.ActiveSheet.Cells(k, qltcol))
           MsgBox ("before union")
           Set multiplerange = Union(range1, range2, range3, range4, range5, range6)
           multiplerange.Copy
           MsgBox (k)

即使在第一个工作簿中也无法选择简单的选择,但是我需要将所有信息从选定的工作簿联合副本复制到另一个工作簿。

           DestWbk.Sheets("sheet1").Range(DestWbk.Sheets("sheet1").Cells(1, 1), DestWbk.Sheets("sheet1").Cells(1, 5)).Select

           MsgBox ("paste done")

           SrcWbk.Close True

       Next file

End Sub

非常感谢您的帮助!

当我尝试包含DestWbk.Sheets("sheet1").Range(DestWbk.Sheets("sheet1").Cells(1, 1), DestWbk.Sheets("sheet1").Cells(1, 5)).Select时 首先,它会选择适当的单元格,并且一切都很好,但是当我在最后加入这一行代码时,就会出现运行时错误。

1 个答案:

答案 0 :(得分:0)

我仍然不太确定为什么选择方法无效。但是我发现它可以与pastespecial函数一起工作,不知道为什么它不能与简单粘贴一起工作。

    DestWbk.Sheets("sheet1").Range(DestWbk.Sheets("sheet1").Cells(1, 1), DestWbk.Sheets("sheet1").Cells(k, 7)).PasteSpecial

工作正常。