Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Sign In with Facebook Sign In with Google Sign In with OpenID

Categories

We have migrated to a new platform! Please note that you will need to reset your password to log in (your credentials are still in-tact though). Please contact lee@programmersheaven.com if you have questions.
Welcome to the new platform of Programmer's Heaven! We apologize for the inconvenience caused, if you visited us from a broken link of the previous version. The main reason to move to a new platform is to provide more effective and collaborative experience to you all. Please feel free to experience the new platform and use its exciting features. Contact us for any issue that you need to get clarified. We are more than happy to help you.

Copying data from one workbook and then transposing/pasting to another

nathan2314nathan2314 Posts: 3Member
I'm trying to piece together some VBA code that will go through a folder and open all .xls files, copy a certain range (the data is in a column), and paste it in a master .xls file transposed (so each column in the data .xls files would become rows in the master). As each data .xls is opened and the data copied, I want it to be copied to the next open row in the master. I've figured out how to go through each .xls file in a folder, open it, and select the data. How do I transpose it to the masterexcel file ??
Also, the sheet name in all the .xls files in the folder are all the same. Also, the data is in the same range for each .xls data files. Also, the part where I need to append to the master file at the next blank row is also working. The part that is not is
[code]basebook.Sheets("Sheet1").Range("A" & EndRow).Selection.PasteSpecial Paste:=xlPasteValues,Operation:=xlNone,SkipBlanks:=False, Transpose:=True [/code]


This is the full macro

[code]Sub ExtractData()
Dim basebook As Workbook
Dim mybook As Workbook
Dim FNames As String
Dim MyPath As String
Dim MyCompletePath As String
Dim SaveDriveDir As String
Dim Cnum As Integer

MyCompletePath = ActiveWorkbook.FullName
MyPath = ActiveWorkbook.Path
SaveDriveDir = MyPath

'MyPath = "C:Alice WongResponsesSubmission"
'file path
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
'clear all cells on the first sheet
basebook.Sheets("Sheet1").Cells.Clear
Do While FNames <> ""
If FNames <> "MasterCompile.xls" Then
Set mybook = Workbooks.Open(FNames)
' Get Row number to Copy new data to
EndRow = basebook.Sheets("Sheet1").Cells(65536, 1).End(xlUp).Row+1
' Select the current data area.
mybook.Sheets("sheets1").Range("A1:A8").Select

basebook.Sheets("Sheet1").Range("A" & EndRow).Selection.PasteSpecial Paste:=xlPasteValues,Operation:=xlNone,SkipBlanks:=False, Transpose:=True

Application.CutCopyMode = False
mybook.Close False
End If
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
basebook.Save
End Sub [/code]

Comments

Sign In or Register to comment.