Copy, Paste and Transpose

[Card Maker]

Hi all

I'm new to VBA but trying to learn!

I am copy some filtered data (using SpecialCells which I found here!) and trying to paste the data to columns in another sheet. The data can be 1 to about 12 rows and six columns (sorry I'm not allowed attachments). My code gives me an "Application or Object Error" on the paste line. Most of my code I've copied from various posts on this site(hope that's OK!!). The main data is in a sheet called "Raw" and I copy filtered data to a sheet called "Data" but I need it transposed into columns rather than rows. I don't even know if the transpose works because I keep getting an error!

Can anyone help?


Sub CopyFilteredData()
Dim LastRow As Long
Dim rRng1 As Range
Dim rRng2 As Range
LastRow = Sheets("Raw").Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set rRng1 = Sheets("Raw").Range(Cells(2, 1), Cells(LastRow, 6))
Set rRng2 = rRng1.SpecialCells(xlCellTypeVisible)
rRng2.Copy
Sheets("Data").Range("A1").End(xlToRight).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
End Sub



Thank you!
Ann

[austenr]

What version of EXCEL are you running?

[Card Maker]

Sorry :doh: - Excel XP on Windows XP


(I've never posted to one of these forums before!!)

Thanks

[Bob Phillips]

You have to dot qualify all objects on the sheet


Sub CopyFilteredData()
Dim LastRow As Long
Dim rRng1 As Range
Dim rRng2 As Range
Dim LastCol As Long
With Sheets("Raw")
LastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set rRng1 = .Range(.Cells(2, 1), .Cells(LastRow, 6))
End With
Set rRng2 = rRng1.SpecialCells(xlCellTypeVisible)
rRng2.Copy
With Sheets("Data")
If .Range("A1").Value = "" Then
LastCol = 1
Else
LastCol = .Range("A1").End(xlToRight).Column
End If
.Cells(1, LastCol).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, _
Transpose:=True
End With
Application.CutCopyMode = False
End Sub

[Card Maker]

xld

Thanks for your reply.

I still receive an "Application or Object" error on the pastespecial line. Am I doing something wrong?

I really appreciate your help.

Ann

[Card Maker]

Can anyone help?

Please?

Ann

[Bob Phillips]

Ann,

It works for me.

can you post your workbook so that we can see the problem?

[Card Maker]

Hi xld

I'm not allowed to use attachments.

But I did notice that the value for LastCol is 256, which I think, means that the code is trying to paste off the sheet? There will be data in one or more columns on the Data sheet - I just need to find the next blank column. Is this the problem?

Thanks again for your help.

Ann

[Bob Phillips]

Hi xld

I'm not allowed to use attachments.

But I did notice that the value for LastCol is 256, which I think, means that the code is trying to paste off the sheet? There will be data in one or more columns on the Data sheet - I just need to find the next blank column. Is this the problem?

Thanks again for your help.

Ann

I got that in my testing, and catered for it (at least with my data I did).

Can you tell me what is on that line, in the cells. Surely you dont have all 256 filled?

[Card Maker]

Hi xld

There is only data in Column A at the moment (with my test data). It could be up to 20 or so columns eventually though.

Thanks

Ann

[Bob Phillips]

Ann,

This version seems to take care of it, and all others



Sub CopyFilteredData()
Dim LastRow As Long
Dim rRng1 As Range
Dim rRng2 As Range
Dim LastCol As Long
With Sheets("Raw")
LastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set rRng1 = .Range(.Cells(2, 1), .Cells(LastRow, 6))
End With
Set rRng2 = rRng1.SpecialCells(xlCellTypeVisible)
rRng2.Copy
With Sheets("Data")
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
With .Cells(1, LastCol)
If LastCol = 1 And .Range("A1") = "" Then
.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Else
.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End If
End With
End With
Application.CutCopyMode = False
End Sub

[Card Maker]

Thank you! Thank you!

Could I possibly ask you one more question?

Would it be possible to take the data from the six rows and paste it into just one column? I mean with row 1 first then row 2 under row 1 and so on. Is that possible? How would I change your code to do that?

Ann.

[Bob Phillips]

Thank you! Thank you!

Could I possibly ask you one more question?

Would it be possible to take the data from the six rows and paste it into just one column? I mean with row 1 first then row 2 under row 1 and so on. Is that possible? How would I change your code to do that?

Ann.

Ann,

Is this what you mean?



Sub CopyFilteredData()
Dim LastRow As Long
Dim rRng1 As Range
Dim rRng2 As Range
Dim LastCol As Long
Dim ColOffset As Long
Dim row As Range
Dim i As Long
With Sheets("Raw")
LastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).row
Set rRng1 = .Range(.Cells(2, 1), .Cells(LastRow, 6))
End With
Set rRng2 = rRng1.SpecialCells(xlCellTypeVisible)
rRng2.Copy
With Sheets("Data")
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
If LastCol = 1 And .Range("A1") = "" Then
ColOffset = 0
Else
ColOffset = 1
End If
With .Cells(1, LastCol)
i = 0
For Each row In rRng2.Rows
row.Copy
.Offset(i, ColOffset).PasteSpecial Paste:=xlPasteValues, Transpose:=True
i = i + row.Cells.Count
Next row
End With
End With
Application.CutCopyMode = False
End Sub

[Card Maker]

Wow!!!

You are a genius! :bow: :clap: :yes :clap:

I wthink I understand most of your code but I will try and learn as much as I can.

Thanks so much!!

Regards

Ann

[Bob Phillips]

Ann,

Can you mark the thread as solved please, to keep the forum tidy.

You do this from the 'Thread Tools' at the head of the thread.