Solved: What's wrong with my Paste Special Transpose Code?

[genracela]

I have a paste transpose code that works properly in my old file, but with my new file it works but instead of just copying the cell, it fills in series.

How will I modify it to paste special then copy cells, and not copying it in series?


Option Explicit
Public Sub Process1()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long, j As Long
Dim LastRow As Long
Dim LastCol As Long

With ThisWorkbook.Sheets("Transposed Data")

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Columns(3).Insert
For i = LastRow To 2 Step -1

.Rows(i + 1).Resize(LastCol - 2).Insert
.Cells(1, "D").Resize(, LastCol - 2).Copy
.Cells(i + 1, "C").Resize(LastCol - 2).PasteSpecial _
Paste:=xlPasteAll, _
Transpose:=True
.Cells(i, "D").Resize(, LastCol - 2).Copy
.Cells(i + 1, "D").Resize(LastCol - 2).PasteSpecial _
Paste:=xlPasteAll, _
Transpose:=True
.Cells(i, "A").Resize(, 2).AutoFill .Cells(i, "A").Resize(LastCol - 1, 2)
.Rows(i).Delete
Next i

.Columns(3).AutoFit
.Range("C1:D1").Value = Array("Campaign", "Forecast QTY")
.Range("E1", Cells(1, LastCol)).ClearContents
End With
End Sub






Thanks!

[Blade Hunter]

You are copying and pasting from the same sheet (Which is the results sheet "Transposed Data") I would imagine you want to do something "like" this:


Option Explicit
Public Sub Process1()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long, j As Long
Dim LastRow As Long
Dim LastCol As Long

With ThisWorkbook.Sheets("Transposed Data")

'CHANGED
LastRow = Sheets("Original Data").Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
'CHANGED
LastCol = Sheets("Original Data").Cells(4, .Columns.Count).End(xlToLeft).Column
.Columns(3).Insert
For i = LastRow To 2 Step -1

.Rows(i + 1).Resize(LastCol - 2).Insert
'CHANGED
Sheets("Original Data").Cells(1, "D").Resize(, LastCol - 2).Copy
.Cells(i + 1, "C").PasteSpecial Paste:=xlPasteAll, Transpose:=True
'CHANGED
Sheets("Original Data").Cells(i, "D").Resize(, LastCol - 2).Copy
.Cells(i + 1, "D").PasteSpecial Paste:=xlPasteAll, Transpose:=True
.Cells(i, "A").Resize(, 2).AutoFill .Cells(i, "A").Resize(LastCol - 1, 2)
.Rows(i).Delete
Next i

.Columns(3).AutoFit
.Range("C1:D1").Value = Array("Campaign", "Forecast QTY")
.Range("E1", Cells(1, LastCol)).ClearContents
End With
End Sub


You will need to make further changes I would think. What exactly are you wanting it to do?

[genracela]

I tried the code that you did, but it doesn't work as I want it to.

Actually, the code that I posted is okay, I just want to modify the pasting.

Instead of copying then pasting it in "fill series", I want it to copy and paste it in "copy cells".

[genracela]

Actually, I got it now...

Instead of

Transpose:=True
.Cells(i, "A").Resize(, 2).AutoFill.Cells(i, "A").Resize(LastCol - 1, 2)
.Rows(i).Delete

I modified it to

Transpose:=True
.Cells(i, "A").Resize(, 2).Copy .Cells(i, "A").Resize(LastCol - 1, 2)
.Rows(i).Delete

Thanks!