Macro Help Needed: Compiling data from multiple sheets and then transposing it during the paste.

Here's the code I am running now to copy (for example) data from
survey3.xls into RawData.xls, which works like a charm, but I need it
to then transpose the data as it pastes it into the sheet.

Sub Compile()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "C:\Documents and Settings\rspidle\Desktop\CNA Survey"
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet
rnum = 0

Do While FNames <> ""
If LCase(Left(FNames, 4)) <> "survey" Then
Set mybook = Workbooks.Open(FNames)
rnum = rnum + 1
Set sourceRange = mybook.Worksheets(1).Range("I1:I140")
Set destrange = basebook.Worksheets(1).Cells(2, rnum)
basebook.Worksheets(1).Cells(1, rnum).Value = mybook.Name
sourceRange.Copy destrange
mybook.Close False
End If
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub


Also, is there by any chance an easy pivot table macro out there to
create pivot tables from this data?

> Also, is there by any chance an easy pivot table macro out there to
> create pivot tables from this data?

Establish some sample/representative data.

turn on the macro recorder and then create the pivottable manually. Then
turn off the macro recorder and look at/adapt the recorded code.

--
Regards,
Tom Ogilvy


"[email protected]" wrote:

> Here's the code I am running now to copy (for example) data from
> survey3.xls into RawData.xls, which works like a charm, but I need it
> to then transpose the data as it pastes it into the sheet.
>
> Sub Compile()
> Dim basebook As Workbook
> Dim mybook As Workbook
> Dim sourceRange As Range
> Dim destrange As Range
> Dim rnum As Long
> Dim SourceRcount As Long
> Dim FNames As String
> Dim MyPath As String
> Dim SaveDriveDir As String
>
> SaveDriveDir = CurDir
> MyPath = "C:\Documents and Settings\rspidle\Desktop\CNA Survey"
> ChDrive MyPath
> ChDir MyPath
>
> FNames = Dir("*.xls")
> If Len(FNames) = 0 Then
> MsgBox "No files in the Directory"
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Exit Sub
> End If
>
> Application.ScreenUpdating = False
> Set basebook = ThisWorkbook
> basebook.Worksheets(1).Cells.Clear
> 'clear all cells on the first sheet
> rnum = 0
>
> Do While FNames <> ""
> If LCase(Left(FNames, 4)) <> "survey" Then
> Set mybook = Workbooks.Open(FNames)
> rnum = rnum + 1
> Set sourceRange = mybook.Worksheets(1).Range("I1:I140")
> Set destrange = basebook.Worksheets(1).Cells(2, rnum)
> basebook.Worksheets(1).Cells(1, rnum).Value = mybook.Name
> sourceRange.Copy destrange
> mybook.Close False
> End If
> FNames = Dir()
> Loop
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Application.ScreenUpdating = True
> End Sub
>
>
> Also, is there by any chance an easy pivot table macro out there to
> create pivot tables from this data?
>
>

With all the variation of data, I think I'd just record a macro when I did it
manually.

If you want some tips on Pivottable coding, visit Debra Dalgleish's site:
http://www.contextures.com/tiptech.html

She has lots of stuff under the pivottable section.

If you like her site, you may like her book:
http://www.amazon.com/gp/product/159...32103?n=283155



"[email protected]" wrote:
>
> Here's the code I am running now to copy (for example) data from
> survey3.xls into RawData.xls, which works like a charm, but I need it
> to then transpose the data as it pastes it into the sheet.
>
> Sub Compile()
> Dim basebook As Workbook
> Dim mybook As Workbook
> Dim sourceRange As Range
> Dim destrange As Range
> Dim rnum As Long
> Dim SourceRcount As Long
> Dim FNames As String
> Dim MyPath As String
> Dim SaveDriveDir As String
>
> SaveDriveDir = CurDir
> MyPath = "C:\Documents and Settings\rspidle\Desktop\CNA Survey"
> ChDrive MyPath
> ChDir MyPath
>
> FNames = Dir("*.xls")
> If Len(FNames) = 0 Then
> MsgBox "No files in the Directory"
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Exit Sub
> End If
>
> Application.ScreenUpdating = False
> Set basebook = ThisWorkbook
> basebook.Worksheets(1).Cells.Clear
> 'clear all cells on the first sheet
> rnum = 0
>
> Do While FNames <> ""
> If LCase(Left(FNames, 4)) <> "survey" Then
> Set mybook = Workbooks.Open(FNames)
> rnum = rnum + 1
> Set sourceRange = mybook.Worksheets(1).Range("I1:I140")
> Set destrange = basebook.Worksheets(1).Cells(2, rnum)
> basebook.Worksheets(1).Cells(1, rnum).Value = mybook.Name
> sourceRange.Copy destrange
> mybook.Close False
> End If
> FNames = Dir()
> Loop
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Application.ScreenUpdating = True
> End Sub
>
> Also, is there by any chance an easy pivot table macro out there to
> create pivot tables from this data?

--

Dave Peterson

> Also, is there by any chance an easy pivot table macro out there to
> create pivot tables from this data?

Establish some sample/representative data.

turn on the macro recorder and then create the pivottable manually. Then
turn off the macro recorder and look at/adapt the recorded code.

--
Regards,
Tom Ogilvy


"[email protected]" wrote:

> Here's the code I am running now to copy (for example) data from
> survey3.xls into RawData.xls, which works like a charm, but I need it
> to then transpose the data as it pastes it into the sheet.
>
> Sub Compile()
> Dim basebook As Workbook
> Dim mybook As Workbook
> Dim sourceRange As Range
> Dim destrange As Range
> Dim rnum As Long
> Dim SourceRcount As Long
> Dim FNames As String
> Dim MyPath As String
> Dim SaveDriveDir As String
>
> SaveDriveDir = CurDir
> MyPath = "C:\Documents and Settings\rspidle\Desktop\CNA Survey"
> ChDrive MyPath
> ChDir MyPath
>
> FNames = Dir("*.xls")
> If Len(FNames) = 0 Then
> MsgBox "No files in the Directory"
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Exit Sub
> End If
>
> Application.ScreenUpdating = False
> Set basebook = ThisWorkbook
> basebook.Worksheets(1).Cells.Clear
> 'clear all cells on the first sheet
> rnum = 0
>
> Do While FNames <> ""
> If LCase(Left(FNames, 4)) <> "survey" Then
> Set mybook = Workbooks.Open(FNames)
> rnum = rnum + 1
> Set sourceRange = mybook.Worksheets(1).Range("I1:I140")
> Set destrange = basebook.Worksheets(1).Cells(2, rnum)
> basebook.Worksheets(1).Cells(1, rnum).Value = mybook.Name
> sourceRange.Copy destrange
> mybook.Close False
> End If
> FNames = Dir()
> Loop
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Application.ScreenUpdating = True
> End Sub
>
>
> Also, is there by any chance an easy pivot table macro out there to
> create pivot tables from this data?
>
>

With all the variation of data, I think I'd just record a macro when I did it
manually.

If you want some tips on Pivottable coding, visit Debra Dalgleish's site:
http://www.contextures.com/tiptech.html

She has lots of stuff under the pivottable section.

If you like her site, you may like her book:
http://www.amazon.com/gp/product/159...32103?n=283155



"[email protected]" wrote:
>
> Here's the code I am running now to copy (for example) data from
> survey3.xls into RawData.xls, which works like a charm, but I need it
> to then transpose the data as it pastes it into the sheet.
>
> Sub Compile()
> Dim basebook As Workbook
> Dim mybook As Workbook
> Dim sourceRange As Range
> Dim destrange As Range
> Dim rnum As Long
> Dim SourceRcount As Long
> Dim FNames As String
> Dim MyPath As String
> Dim SaveDriveDir As String
>
> SaveDriveDir = CurDir
> MyPath = "C:\Documents and Settings\rspidle\Desktop\CNA Survey"
> ChDrive MyPath
> ChDir MyPath
>
> FNames = Dir("*.xls")
> If Len(FNames) = 0 Then
> MsgBox "No files in the Directory"
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Exit Sub
> End If
>
> Application.ScreenUpdating = False
> Set basebook = ThisWorkbook
> basebook.Worksheets(1).Cells.Clear
> 'clear all cells on the first sheet
> rnum = 0
>
> Do While FNames <> ""
> If LCase(Left(FNames, 4)) <> "survey" Then
> Set mybook = Workbooks.Open(FNames)
> rnum = rnum + 1
> Set sourceRange = mybook.Worksheets(1).Range("I1:I140")
> Set destrange = basebook.Worksheets(1).Cells(2, rnum)
> basebook.Worksheets(1).Cells(1, rnum).Value = mybook.Name
> sourceRange.Copy destrange
> mybook.Close False
> End If
> FNames = Dir()
> Loop
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Application.ScreenUpdating = True
> End Sub
>
> Also, is there by any chance an easy pivot table macro out there to
> create pivot tables from this data?

--

Dave Peterson