For Each Looping Trouble

[Philip1957]

Greetings,

I am trying to copy and transpose information from one worksheet to another, then copy a range from the source worksheet to paste and fill down adjacent to the transposed data. I have this code that works once for a single row.

 'Copy & Paste Ref Desig Transposed
    Range("K5", Range("K5").End(xlToRight)).Copy
    Sheets("Tabular").Range("A1").PasteSpecial , Transpose:=True
    
    'Copy Item & Desc.  Paste & fill down
    Range("I5:J5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabular").Select
    Range("B1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("B1:C3")

I need this to loop through the entire worksheet (about 50 rows) and append each transposed range into Column A of the destination worksheet. I have taken my original code and wrapped it in a For Each loop (found via Google) but I clearly don't understand how to make it work. Here is my most recent failure.

Private Sub Transpose()
Dim sh As Worksheet
Dim rw As Range
Dim RowCount As Integer

RowCount = 0
    
    Worksheets("Orig").Activate
    
Set sh = ActiveSheet
For Each rw In sh.Rows
    
    'Copy & Paste Ref Desig Transposed
    Range("K5", Range("K5").End(xlToRight)).Copy
    Sheets("Tabular").Range("A1").PasteSpecial , Transpose:=True
    
    'Copy Item & Desc.  Paste & fill down
    Range("I5:J5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabular").Select
    Range("B1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("B1:C3")
    
RowCount = RowCount + 1

Next rw


End Sub  'Transpose

Also, each transposed range is variable in length so I realize my Autofill statement with a fixed range won't do what I need it to but, I don't know how to use xlend with 2 columns.

Any help with this would be greatly appreciated.

Thanks in advance for your time and patience,
~ Phil

 

[Philip1957]

Please ignore my idiot code above. I was in a hurry.

So I have a loop that I think works now because I can see x in the locals window incrementing, but it keeps going back to the same range to copy. Obviously this is because I have specified a fixed range with this code.

Private Sub Transpose()
Dim x As Integer
Dim NumRows As Variant


    ' Set numrows = number of rows of data.
    NumRows = Range("K2", Range("K2").End(xlDown)).Rows.Count

    ' Select cell K1.
    Range("K2").Select

    ' Establish "For" loop to loop "numrows" number of times.
    For x = 1 To NumRows

     'Copy & Paste Ref Desig Transposed
    Range("K2", Range("K2").End(xlToRight)).Copy
    Sheets("Tabular").Range("A1").PasteSpecial , Transpose:=True

    Worksheets("Orig").Activate

    ' Selects cell down 1 row from active cell.
    ActiveCell.Offset(1, 0).Select
    Next

End Sub  'Transpose

I tried converting the A1 style references into R1C1 but this gives me an "Application-defined or object defined error" (Run-time 1004).

Private Sub Transpose()
Dim x As Integer
Dim NumRows As Variant


    ' Set numrows = number of rows of data.
    NumRows = Range("K1", Range("K1").End(xlDown)).Rows.Count

    ' Select cell K1.
    Range("K1").Select

    ' Establish "For" loop to loop "numrows" number of times.
    For x = 1 To NumRows

     'Copy & Paste Ref Desig Transposed
    Range(Cells(1, 0), Range(Cells(1, 0).End(xlToRight))).Copy
    Sheets("Tabular").Range("A1").PasteSpecial , Transpose:=True

    Worksheets("Orig").Activate

    ' Selects cell down 1 row from active cell.
    ActiveCell.Offset(1, 0).Select
    Next

End Sub  'Transpose

What is wrong with my syntax?

Again, any assistance is greatly appreciated.

~ Phil

 

[RoryA]

What is wrong with my syntax?

Everything?
You can't have column 0, and it's Range(cells(row, col), Cells(row, col))

It's not really clear to me how you want the copy range to change at each iteration since you don't use x anywhere inside the loop?

 

[Philip1957]

Rory,

Thanks for the response. I'm not surprised that everything is wrong with my syntax, I'm not very skilled at this. I generally record or find code snippets on Google, string them together, and try to beat it into submission with help from my VBA fo Dummies book. Not having much luck with that method with this macro.

So I changed the copy statement to

 ActiveCell.End(xlToRight).Copy

It steps through the rows because of the closing Offset statement (?) but is only copying the last cell in the range. I'm guessing that my orphan x means it isn't counting and won't know when to stop.
Also, when it pastes it overwrites the previous in cell A1 on sheet tabular. I guess I need an offset or xlend there?

That leaves me with three questions:

1. What's the syntax for capturing the active cell and all populated cells to the right for copying?
2. How do I get the Paste portion of the operation to append instead of overwrite?
3. What do I do with my orphan x to make the macro stop at the end of the list?

Thanks again for your time & patience.
~ Phil

 

[Philip1957]

Did some work on this over the weekend.

Private Sub Transpose()
Dim copysheet As Worksheet
Dim pastesheet As Worksheet
Dim NumRows As Variant
Dim rw As Long
rw = 2
Set copysheet = Worksheets("Orig")
Set pastesheet = Worksheets("Tabular")

    ' Set numrows = number of rows of data.
    NumRows = copysheet.Range("K1", Range("K1").End(xlDown)).Rows.Count

    ' Establish "For" loop to loop "numrows" number of times.
    For rw = 2 To NumRows

     'Copy & Paste Ref Desig Transposed
    copysheet.Range(Cells(rw, 11), Cells(rw, 16)).Copy
    pastesheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial , Transpose:=True
    Application.CutCopyMode = False

    rw = rw + 1
    
    Next

End Sub  'Transpose

It works now but only copies from (rw,11) to (rw, 16). What I need it to do is copy from (rw,11) to the last value in the row. I don't seem to be able to get any combination of end xltoright to work with R1C1 notation.

Any help would be greatly appreciated.
~ Phil

 

[Philip1957]

I kept working at this and finally kit on the right syntax.

Private Sub Transpose()
Dim copysheet As Worksheet
Dim pastesheet As Worksheet
Dim NumRows As Variant
Dim rw As Long
Dim lCol As Long
rw = 2
Set copysheet = Worksheets("Orig")
Set pastesheet = Worksheets("Tabular")

    ' Set numrows = number of rows of data.
    NumRows = copysheet.UsedRange.Rows.Count


    ' Establish "For" loop to loop "numrows" number of times.
    For rw = 2 To NumRows

     'Copy & Paste Ref Desig Transposed
    lCol = Cells(rw, Columns.Count).End(xlToLeft).Column
    copysheet.Range(Cells(rw, 11), Cells(rw, lCol)).Copy
    pastesheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial , Transpose:=True
    Application.CutCopyMode = False


    rw = rw + 1
    
    Next

End Sub  'Transpose

Thanks to Rory for his reply.

~ Phil