Help needed to transpose range of data to the next blank row in another worksheet

[kmeiyin]

Hi, I need help with Visual Basic. I only know how to record macros (which results in very long scripts), and need help with this code.

Background info:
I have 2 worksheets in this file:
1 – Calculator (which I will key in some numbers).
2 – Summary (which, at the click of a button, I want the data from Calculator transposed into, to the next blank row).

At present, the recorder records my action for 3 parts:
1 – Data from D3:N3 of Calculator, and transpose them to column B of Summary (it’s supposed to go to the next blank row, and I need help doing). Note: At present I have data up to column N, but this will expand soon to more columns.
2 – Data from D23:N23, and transpose them to column C of Summary (it’s supposed to go to the next blank row, and I need help doing). Note: At present I have data up to column N, but this will expand soon to more columns.
3 – A single cell B2 and copy-paste value it to column A (which will fill in all the cells until the last row where the last piece of data stops (i.e. at present, 11 rows down).

I need help in:
1 – To review my code, and simplify it
2 – To be able to append my data, at the click of a button, to the next blank row in Summary
3 – To help me understand the codes so that I can change the codes with my columns expand.

This is my code:

Sub Transpose()
'
' Transpose Macro
'
 
'
    Range("D3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Summary").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Calculator").Select
    Range("D23").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Summary").Select
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Sheets("Calculator").Select
    Range("C1").Select
    Selection.End(xlToLeft).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Summary").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("A2:A12"), Type:=xlFillDefault
    Range("A2:A12").Select
End Sub

Thanks!

 

[adkock]

Hi,

try something like

Sub TransposeData
Dim myRng1 as String
Dim GoalCol1 as String
Dim myRng2 as String
Dim GoalCol2 as String
Dim myRng3 as String
Dim GoalCol3 as String
Dim SourceSheet as String
Dim GoalSheet as String

SourceSheet = "Calculator"
GoalSheet = "Summary"
myRng1 = "D3:N3"
GoalCol1 = "B"
myRng2 = "D23:N23"
GoalCol2 = "C"
myRng3 = "B2"
GoalCol3 = "A"

For each cell in sheets(SourceSheet).Range(myRng1)
   Sheets(GoalSheet).Range(GoalCol1 & 1000000).End(xlUp).Offset(1,0) = cell.value
   Next

For each cell in sheets(SourceSheet).Range(myRng2)
   Sheets(GoalSheet).Range(GoalCol2 & 1000000).End(xlUp).Offset(1,0) = cell.value
   Next

For each cell in sheets(SourceSheet).Range(myRng3)
   Sheets(GoalSheet).Range(GoalCol3 & 1000000).End(xlUp).Offset(1,0) = cell.value
   Next

End Sub

 

[kmeiyin]

Thanks adkock. It worked!

I realized I gave the wrong cell for the third part. It should have read "B1". I changed it in accordingly. The only portion which does not seem to work is the "autofill" part of the copied cell from B1 to the Summary sheet. It does not autofill all the way down to the last "filled" row.

p.s. The codes are really simple and clear - even for a "level 0" VB user like me :D Thank you! Thank you! Thank you!

 

[adkock]

Happy to help kmeiyin.

I did not read your question accurately enough, so the autofilling of component 3 was not included in the code. Please try the following:

Sub TransposeData()
 Dim myRng1 As String
 Dim GoalCol1 As String
 Dim myRng2 As String
 Dim GoalCol2 As String
 Dim myRng3 As String
 Dim GoalCol3 As String
 Dim SourceSheet As String
 Dim GoalSheet As String
 Dim StartRow As Integer
 Dim LastRow As Integer
 Dim cell As Range
  
 SourceSheet = "Calculator"
 GoalSheet = "Summary"
 myRng1 = "D3:N3"
 GoalCol1 = "B"
 myRng2 = "D23:N23"
 GoalCol2 = "C"
 myRng3 = "B1"
 GoalCol3 = "A"
  
 'Transpose each data value in myRng1 to summary
 For Each cell In Sheets(SourceSheet).Range(myRng1)
    Sheets(GoalSheet).Range(GoalCol1 & 1000000).End(xlUp).Offset(1, 0) = cell.Value
 Next

 'Transpose each data value in myRng2 to summary
 For Each cell In Sheets(SourceSheet).Range(myRng2)
 Sheets(GoalSheet).Range(GoalCol2 & 1000000).End(xlUp).Offset(1, 0) = cell.Value
 Next

 'Enter value from myRng3 in remaining open lines
 Set cell = Sheets(SourceSheet).Range(myRng3)
 StartRow = Sheets(GoalSheet).Range(GoalCol3 & 1000000).End(xlUp).Offset(1, 0).Row
 LastRow = Sheets(GoalSheet).Cells.SpecialCells(xlCellTypeLastCell).Row
 Sheets(GoalSheet).Range(GoalCol3 & StartRow & ":" & GoalCol3 & LastRow) = cell.Value
 Set cell = Nothing
 End Sub

 

[kmeiyin]

Thanks adkock. It worked perfectly!