Transpose Data

[Emanuele]

Hi guys, i would like to know how to add the transpose option to that part of code
Thx!

            Set DestSh = ActiveWorkbook.Worksheets.Add
            Last = LastCol(DestSh)
            Set Copy1 = sh.Range("C10:AZ10")
                 With Copy1
                      DestSh.Cells(1, Last + 1).Resize(.Rows.Count, .Columns.Count).Value = .Value
                 End With

 

[VBE313]

Please post entire code

 

[Fluff]

How about

   With Copy1
      DestSh.Cells(1, Last + 1).Resize(.Columns.Count).Value = Application.Transpose(.Value)
   End With

 

[Emanuele]

How about

   With Copy1
      DestSh.Cells(1, Last + 1).Resize(.Columns.Count).Value = Application.Transpose(.Value)
   End With

Thank you Fluff, it partially works because i didn't explain good enough.
The code should get data from multiple worksheet and put it in a single column, actually, thx to your code, get data from the multiple worksheet but put them in separate colums

Please post entire code

Ok, it's a code that i found online that I would like to modify

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function
Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function
Sub AppendDataAfterLastColumn()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Delete the summary worksheet if it exists.
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("Statistics").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    ' Add a worksheet with the name ""
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "Statistics"

    ' Loop through all worksheets and copy the data to the
     'summary worksheet.
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then

            ' Find the last column with data on the summary
            ' worksheet.
            Last = LastCol(DestSh)

            ' Fill in the columns that you want to copy.
            Set Copy1 = sh.Range("C10:AZ10")

            ' Test to see whether there enough rows in the summary
            ' worksheet to copy all the data.
            If Last + CopyRng.Columns.Count > DestSh.Columns.Count Then
                MsgBox "There are not enough columns in " & _
                   "the summary worksheet."
                GoTo ExitTheSub
            End If

            ' This statement copies values, formats, and the column width.
            With Copy1
             DestSh.Cells(2, Last + 1).Resize(Rows.Count.Columns.Count).Value =.Value
                End With

        End If
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[Fluff]

How about

   Last = LastCol(DestSh)
   
   For Each Sh In ActiveWorkbook.Worksheets
      If Sh.Name <> DestSh.Name Then
         
         ' Fill in the columns that you want to copy.
         Set Copy1 = Sh.Range("C10:AZ10")
         
         ' This statement copies values, formats, and the column width.
         With Copy1
            DestSh.Cells(Rows.Count, Last + 1).End(xlUp).Offset(1).Resize(.Columns.Count).Value = .Value
         End With
         
      End If
   Next Sh

 

[Emanuele]

How about

   Last = LastCol(DestSh)
  
   For Each Sh In ActiveWorkbook.Worksheets
      If Sh.Name <> DestSh.Name Then
        
         ' Fill in the columns that you want to copy.
         Set Copy1 = Sh.Range("C10:AZ10")
        
         ' This statement copies values, formats, and the column width.
         With Copy1
            DestSh.Cells(Rows.Count, Last + 1).End(xlUp).Offset(1).Resize(.Columns.Count).Value = .Value
         End With
        
      End If
   Next Sh

Thank you for answering me but the new code doesn't work. It only gets the value of the cell C10 of each worksheet and copy it in 3 different column with the same size

 

[Fluff]

Oops, missed the transpose

 DestSh.Cells(Rows.Count, Last + 1).End(xlUp).Offset(1).Resize(.Columns.Count).Value = Application.Transpose(.Value)

 

[Emanuele]

Oops, missed the transpose

DestSh.Cells(Rows.Count, Last + 1).End(xlUp).Offset(1).Resize(.Columns.Count).Value = Application.Transpose(.Value)

Thank you Fluff, but the code still doesn't work. As before the code get data from the multiple worksheet but put them in separate colums

 

[Fluff]

Not if you've changed the code as I showed. Can you please post the code you are using?

 

[Emanuele]

Not if you've changed the code as I showed. Can you please post the code you are using?

here is

Sub AppendDataAfterLastColumn()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Delete the summary worksheet if it exists.
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("Statistics").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    ' Add a worksheet with the name ""
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "Statistics"

    ' Loop through all worksheets and copy the data to the
     'summary worksheet.
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then

            ' Find the last column with data on the summary
            ' worksheet.
            Last = LastCol(DestSh)

            ' Fill in the columns that you want to copy.
            Set Copy1 = sh.Range("C9:AZ9")

            ' Test to see whether there enough rows in the summary
            ' worksheet to copy all the data.
            If Last + Copy1.Columns.Count > DestSh.Columns.Count Then
                MsgBox "There are not enough columns in " & _
                   "the summary worksheet."
                GoTo ExitTheSub
            End If

            ' This statement copies values, formats, and the column width.
            'With CopyRng.Copy
            'With DestSh.Cells(Last + 1, 1)
            ' End With
            
            With Copy1
             DestSh.Cells(Rows.Count, Last + 1).End(xlUp).Offset(1).Resize(.Columns.Count).Value = Application.Transpose(.Value)
            End With

        End If
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub