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
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
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"
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
'clear all cells on the first sheet
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.
basebook.Sheets("Sheet1").Range("A" & EndRow).Selection.PasteSpecial Paste:=xlPasteValues,Operation:=xlNone,SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
FNames = Dir()
Application.ScreenUpdating = True
End Sub [/code]
0 · ·