You are here:

Excel/VBA Paste/Transpose

Advertisement


Question
QUESTION: Hi Tom,
Using Excel 2007 VBA:
This is a follow-on from a question you answered a few days ago. Here's what I have (As amended by me). The part I need help with is commented just below "Begin the loop" (starts with "HERE'S where I need...)

Sub MyCode()
   
   Dim bkData As Workbook
   Dim shData As Worksheet
   Dim bkClient As Workbook
   Dim shClient As Worksheet
   Dim r As Range, cell As Range
   Dim fName As Variant
   Dim sPath As String
   Dim s As String, olds As String
   ' Set the directory here:
   sPath = "d:\C_Drive\Data\"    ' make sure this ends with a back slash

'Open the dialog box to select the data file
   ChDrive sPath
   ChDir sPath
   fName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls?),*.xls?", _
     Title:="Select Datafile then click on Open", MultiSelect:=False)
   If TypeName(fName) = "Boolean" Then
     MsgBox "No file selected.  Exiting . . . "
     Exit Sub
   End If
   
   Workbooks.Open fName
   Set bkData = ActiveWorkbook
   Set shData = ActiveSheet
   
'set the range where filenames are found
   Set r = shData.Range("A2", shData.Cells(shData.Rows.Count, "A").End(xlUp))
   For Each cell In r
   s = cell.Value & ".xls"

'BEGIN THE LOOP
   If s <> olds Then
       Set bkClient = Workbooks.Open(sPath & s)
       Set shClient = ActiveSheet
   
   'HERE'S Where I need to determine how many rows there are in the current "s", and which rows they are, because I
   'need to copy from ColC of those rows and paste/transpose to shClient cell C5.
   
    bkClient.Close SaveChanges:=True
    olds = s
   
   End If
   Next
   End Sub

Thank You!

ANSWER: Doug
ShClient is the worksheet in the workbook you just opened - one of the onse in the list of sheets in column A.  But you say you want to determine the last used row in column C of that sheet and then paste transpose to that sheet - but I don't think that is what you mean.  

I will use two generic sheet references.   Sh1 and Sh2.  I will find the extent of the data in sh1 and copy transpose to sh2
If I assume that the data starts in C2 and is contiguous down to the last used cell in column C then

sh1.Range("C2", sh1.Cells(sh1.rows.count, "C").End(xlup).copy
sh.2.Range("C5").PasteSpecial Transpose:=True

Hopefully you can adapt that to what you are trying to do.

--
Regards,
Tom Ogilvy


---------- FOLLOW-UP ----------

QUESTION: Tom,
I was afraid my question might be unclear, and I was right! I am trying to copy from shData to shClient. Heres a mockup of shData (there is a header row):
File   Acct   Data1
cloudy   w1   12
cloudy   w2   13
rainy   x2   15
rainy   x3   16
rainy   x4   20
sunny   a2   21
sunny   a3   22
sunny   a4   51
sunny   a5   23

When the loop opens cloudy.xls (aka: shClient), it should copy from shData(C2:C3) to shClient.Range(C5).
Then when it opens rainy.xls (aka:shClient), it should copy from shData(C4:C6) to shClient.Range(C5). And so on.
I just cant figure out how it will know that file name cloudy (in shData) goes from row 2-3, rainy from 4-6, sunny from 7-10, etc.

Hope I did better that time
Thanks!

Answer
Doug,

Hopefully this will do what you want.

Sub MyCode()
   
   Dim bkData As Workbook
   Dim shData As Worksheet
   Dim bkClient As Workbook
   Dim shClient As Worksheet
   Dim r As Range, cell As Range
   Dim fName As Variant
   Dim sPath As String
   Dim s As String, olds As String
   Dim icnt as Long, jcnt as Long, ii as Long
   ' Set the directory here:
   sPath = "d:\C_Drive\Data\"    ' make sure this ends with a back slash

'Open the dialog box to select the data file
   ChDrive sPath
   ChDir sPath
   fName = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls?),*.xls?", _
     Title:="Select Datafile then click on Open", MultiSelect:=False)
   If TypeName(fName) = "Boolean" Then
     MsgBox "No file selected.  Exiting . . . "
     Exit Sub
   End If
   
   Workbooks.Open fName
   Set bkData = ActiveWorkbook
   Set shData = ActiveSheet
   
'set the range where filenames are found
   Set r = shData.Range("A2", shData.Cells(shData.Rows.Count, "A").End(xlUp))

   icnt = 0
   For Each cell In r
   icnt = icnt + 1
   s = cell.Value & ".xls"

'BEGIN THE LOOP
   If s <> olds Then
         ii = icnt
         jcnt = 1
         Do While r(ii).Value = cell.Value
         jcnt = r(ii).Row - cell.Row + 1
         ii = ii + 1
         Loop
 
       Set bkClient = Workbooks.Open(sPath & s)
       Set shClient = ActiveSheet

   'HERE'S Where I need to determine how many rows there are in the current "s",
   'and which rows they are, because I
   'need to copy from ColC of those rows and paste/transpose to shClient cell C5.

 
     cell.Resize(jcnt, 1).Offset(0, 2).copy
       shClient.Range("C5").PasteSpecial Transpose:=True   
   
    bkClient.Close SaveChanges:=True
    olds = s
   
   End If
   Next
End Sub

--
Regards,
Tom Ogilvy

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.