VBA: PasteSpecial Using Destination Command

brian_griffin

New Member
Joined
Oct 30, 2012
Messages
7
Hello everyone,

I using a VBA code to copy cells from various excel sheets into one master sheet.

I have managed to employ VBA to copy single cells, but now I would like to copy a range of cells and transpose them into the master sheet.

However, I am not able to adapt the paste special command with the destination command.

My recent code is:
Code:
Dim WBQ As Workbook
Dim WBZ As Workbook
Dim lngAnzahl As Long
Dim lngLastQ As Long
 Set WBZ = ActiveWorkbook

...

Set WBQ = Workbooks.Open(Filename:=varDateien(lngAnzahl))
  lngLastQ = WBQ.Worksheets(1).Range("A65536").End(xlUp).Row
  WBQ.Worksheets(1).Range("H22").Copy _
  Destination:=WBZ.Worksheets(1).Range("J" & WBZ.Worksheets(1).Range("J65536").End(xlUp).Row + 1)
WBQ.Close


I would like to copy the cells H22 to H30 into the destination worksheet.

Has anyone any hint? I really appreciate any help.

Thanks in advance,
Brian
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
The Destination:=Range(...) only works on a straight copy/paste.
It doesn't apply to the paste special method.

You have to do it in 2 lines, one to copy, and one to paste special

Something like
Code:
    Range("A1:A3").Copy
    Range("B1:D1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
 
Upvote 0
Qualify the Range with its workbook and worksheet. The code in the original post would be:

Code:
  WBQ.Worksheets(1).Range("H22").Copy
  WBZ.Worksheets(1).Range("J" & WBZ.Worksheets(1).Range("J65536").End(xlUp).Row + 1)").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
 
Upvote 0
Qualify the Range with its workbook and worksheet. The code in the original post would be:

Code:
  WBQ.Worksheets(1).Range("H22").Copy
  WBZ.Worksheets(1).Range("J" & WBZ.Worksheets(1).Range("J65536").End(xlUp).Row + 1)").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

What about copying a worksheet from one workbook to another? I'm trying to copy/paste values on one workbook, and paste it to another workbook that is closed (it could be open, it doesn't matter to me). The problem line I'm getting is:

Code:
 Sheets(wksht).Copy Destination:=newwkbk.Sheets("Sheet1")

I'm not sure why it's not working. Any ideas?

Code:
Sub openfile()


Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim FirstRow As Integer
FirstRow = 7
Dim LastRow As Integer
LastRow = 8


For i = FirstRow To LastRow


Dim myfile As String
myfile = Cells(i, "A").Value & Cells(i, "C").Value
Dim wkbk As String
wkbk = Cells(i, "C").Value
Dim wksht As String
wksht = Cells(i, "D").Value
Set newwkbk = Workbooks.Open("C:\Users\rstoneham\Desktop\Inventory Project\2014\Jan.xlsx")
Dim FolderYr As String
FolderYr = "2014"
   
        Application.Workbooks.Open FileName:=myfile


        Worksheets(wksht).Activate
        ActiveSheet.Cells.EntireRow.Hidden = False
        ActiveSheet.Cells.EntireColumn.Hidden = False
        Range("A1:CZ250").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues


        Sheets(wksht).Copy Destination:=newwkbk.Sheets("Sheet1")


        newwkbk.Activate
        Worksheets(wksht).Activate
    
    On Error Resume Next
    
        Cells.Find(What:="Production Facility", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False).Activate
            
    If Err.Number <> 0 Then
    
    Range("A5").Activate
    ActiveSheet.Name = Application.Proper(ActiveCell.Value)
            With ActiveSheet.Tab
                .ColorIndex = xlNone
                .TintAndShade = 0
            End With
    
    End If
    
        ActiveCell.Offset(rowOffset:=0, ColumnOffset:=1).Activate
        ActiveSheet.Name = Application.Proper(ActiveCell.Value)
            With ActiveSheet.Tab
                .ColorIndex = xlNone
                .TintAndShade = 0
            End With
        Cells(8, 1).Select
    
        Workbooks(wkbk).Activate
        ActiveWorkbook.Close SaveChanges:=False
    
Next i


    newwkbk.Activate
    Sheets("Sheet1").Delete
    Sheets("Sheet2").Delete
    Sheets("Sheet3").Delete
    
    On Error Resume Next
            Cells.Find(What:="Opening Inv", After:=ActiveCell, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase _
            :=False, SearchFormat:=False).Activate
                ActiveCell.Offset(rowOffset:=-1, ColumnOffset:=0).Activate
            
    If Err.Number <> 0 Then
            Cells.Find(What:="Beginning", After:=ActiveCell, LookIn:=xlValues, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase _
            :=False, SearchFormat:=False).Activate
                ActiveCell.Replace What:="Beginning", Replacement:="Opening Inv", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    End If
            
    Cells.Find(What:="Calculation Worksheet", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    ActiveCell.Offset(rowOffset:=1, ColumnOffset:=0).Activate
    ActiveWorkbook.SaveAs ("C:\Users\rstoneham\Desktop\Inventory Project\" & FolderYr & "\" & Format(ActiveCell, "mmm") & ".xlsx")
    
End Sub
 
Upvote 0
The Destination:=Range(...) only works on a straight copy/paste.
It doesn't apply to the paste special method.

You have to do it in 2 lines, one to copy, and one to paste special

Something like
Code:
    Range("A1:A3").Copy
    Range("B1:D1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

I've found a notable drawback of using the 2 line method is that it will leave your cells selected.
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,182
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top