Modify VBA Consolidating data adding transpose option and removing the delete option

Emanuele

New Member
Joined
Feb 25, 2020
Messages
14
Office Version
  1. 2016
Platform
  1. Windows
Hi, everybody, I'm new to the VBA script. I'm trying to use a script in VBA that is working but I would like to modify it so that I get the files, taken from rows, in the same columns. Also I would like to know if it's possible to avoid deleting the created worksheet every time, but simply do an update of an existing page, without taking the data from it too, to which I'm going to add some charts, thank you very much!


Here and example of a series of data for each worksheet, the

1582626332818.png
1582626332818.png


VBA Code:
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("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

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

' 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 CopyRng = sh.Range("C10:AZ10")
Set CopyRng2 = sh.Range("C9:AZ9")

' 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 CopyRng
             DestSh.Cells(1, Last + 1).Resize(.Rows.Count, _
                .Columns.Count).Value = .Value
                End With

            With CopyRng2
             DestSh.Cells(1, 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
 

Some videos you may like

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Watch MrExcel Video

Forum statistics

Threads
1,113,942
Messages
5,545,114
Members
410,660
Latest member
marciabkin
Top