简体   繁体   中英

Union of ranges copy and paste in VBA

I have recently faced the problem with copying the union of the ranges from one worksheet to another one. The problem is that even when I am trying to simply select the ending workbook it fails to do so. Union contains only ranges from 1 WS. I copy all of them, but when I try to move to default workbook it somehow fails to get there.

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)

Even simple selection fails to be selected in the first workbook, whereas I need to copy all of the info from workbook union copy selected to the other one.

           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

Any help will be very much appreciated!

When I try to include DestWbk.Sheets("sheet1").Range(DestWbk.Sheets("sheet1").Cells(1, 1), DestWbk.Sheets("sheet1").Cells(1, 5)).Select at the start, it selects the appropriate cells and everything is okay, but when I include this line of code at the end it gives me run-time error.

I am still not quite sure why selection method didn't work. But I have figured out that it works with pastespecial function, no idea why it doesn't work with simply paste.

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

Worked just fine.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM