0

This code right here range copies from each excel file in the folder and paste in master file. I want it copy,transpose and paste it which this code fails to do so. Please help and thanks in advance.

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
dum = "D:\MACROS Test folder\"
MyFile = Dir(dum)

Do While Len(MyFile) > 0
  If MyFile = "Z_Macro .xlsm" Then
    Exit Sub
  End If

  Workbooks.Open (dum + MyFile)
  Range("F17:F24").Copy
  ActiveWorkbook.Close

  erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
  ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), 
  Cells(erow, 4))

  MyFile = Dir

Loop

End Sub
help-info.de
  • 6,695
  • 16
  • 39
  • 41

2 Answers2

0

Here are some previous questions for you to review which contain solutions about using VBA to paste data in a transposed manner.

Excel VBA - Range.Copy transpose paste

Copy and Paste (transposed & values) a set range in a different sheet in the next empty row

VBA Copy & Transpose Data Range

Transpose a range in VBA

Trouble with PasteSpecial Transpose

VBA Code - Copy and Transpose paste with specific conditions

After you have reviewed those, if you are still having trouble, come back and show us the code you tried and describe what went wrong, and someone may be able to help you.

ed2
  • 1,457
  • 1
  • 9
  • 26
0

Thanks for the suggestion @ed2. after going through these answers, I have somehow managed to make my code to do want i wanted with little more modification. so this is the code

Option Explicit
Sub allmacros()
Call LoopThroughDirectory
Call transpose_copy
End Sub
Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow As Variant
Dim dum As Variant
Dim bswitch As Boolean

dum = "D:\excel vba\New folder\"
MyFile = Dir(dum)
Do While Len(MyFile) > 0
If MyFile = "Master.xlsx" Then
Exit Sub
End If

Workbooks.Open (dum + MyFile)

Range("B1:B4").Copy
ActiveWorkbook.Close

erow = Sheet3.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("sheet3").Range(Cells(erow, 1), Cells(erow, 4))
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

MyFile = Dir

Loop

End Sub

Sub transpose_copy()

Dim x As Integer
x = 2
Do Until IsEmpty(Cells(x, 1))
Range("A" & x & ":A" & x + 3).Select
Selection.Copy
Worksheets("report").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
x = x + 4
Loop
End Sub

what this will do is loop through excel files in the folder, then copy those data and paste it in the empty sheet in master file. Then it will copy and transpose the data from empty sheet to report sheet in the master file