تقرير لتوضيح البيانات

Rem Step 1

Sub Test()

    Dim ws As Worksheet, sh As Worksheet

    Application.ScreenUpdating = False

        Set sh = ThisWorkbook.Worksheets("Come")

        

    Application.ScreenUpdating = True

End Sub

Rem Step 2

Sub Test()

    Dim ws As Worksheet, sh As Worksheet

    Application.ScreenUpdating = False

        Set sh = ThisWorkbook.Worksheets("Come")

        For Each ws In ThisWorkbook.Worksheets

            If ws.Name <> sh.Name Then

                Debug.Print ws.Name

            End If

        Next ws

    Application.ScreenUpdating = True

End Sub

Rem Step 3

Sub Test()

    Dim ws As Worksheet, sh As Worksheet, c As Long

    Application.ScreenUpdating = False

        Set sh = ThisWorkbook.Worksheets("Come")

        c = 10

        For Each ws In ThisWorkbook.Worksheets

            If ws.Name <> sh.Name Then

                Debug.Print c

                c = c + 1

            End If

        Next ws

    Application.ScreenUpdating = True

End Sub

ws.Range("E5:W5").Copy

sh.Cells(6,c).

Paste:=xlPasteValues

Transpose:=True

sh.Cells(6, c).PasteSpecial Paste:=xlPasteValues, Transpose:=True

Rem Step 4

Sub Test()

    Dim ws As Worksheet, sh As Worksheet, c As Long

    Application.ScreenUpdating = False

        Set sh = ThisWorkbook.Worksheets("Come")

        c = 10

        For Each ws In ThisWorkbook.Worksheets

            If ws.Name <> sh.Name Then

                ws.Range("E5:W5").Copy

                sh.Cells(6, c).PasteSpecial Paste:=xlPasteValues, Transpose:=True

                c = c + 1

            End If

        Next ws

    Application.ScreenUpdating = True

End Sub

Option Explicit

Sub All_in_One()



Dim sh As Worksheet

Dim Co As Worksheet

Dim m As Byte

m = 5

Set Co = Sheets("Come")

Co.Range("E7").CurrentRegion.ClearContents

For Each sh In Sheets

 If sh.Name <> Co.Name Then

  sh.Cells(5, 5).Resize(, 19).Copy

  Co.Cells(7, m).PasteSpecial , _

  Paste:=xlPasteValues, Transpose:=True

  m = m + 1

End If

Next

Application.CutCopyMode = False

Co.Range("C5").Select

End Sub