VBA Project – Combined Data Sheets in Excel

[EN] – VBA Project – Get data from sheets “WORDPRESS1”, “WORDPRESS2” and “WORDPRESS3” and put them all together in a new sheet named “CombinedData”. The new sheet “CombinedData” should show all records starting from row 5 and you have to freeze rows 1-5.

[GR] – VBA Project – Πάρε τα δεδομένα από τα φύλλα εργασίας “WORDPRESS1”, “WORDPRESS2” και “WORDPRESS3” και βάλε τα όλα μαζί στο φύλλο εργασίας “CombinedData”. Το νέο φύλλο εργασίας “CombinedData” πρέπει να έχει τα δεδομένα και των τριών φύλλων εργασίας (“WORDPRESS1”, “WORDPRESS2”, “WORDPRESS3”). Τα δεδομένα θα πρέπει να φαίνονται από τη γραμμή 5 και κάτω και θα πρέπει οι 5 πρώτες γραμμές να είναι εμφανείς συνεχώς.

YouTube video: VBA Project – Combined Data Sheets in Excel

 

VBA code for button Create Combined Data

Sub CombineSheetsWithHeadersAndColumnWidth()

Dim wsSource As Worksheet

Dim wsDestination As Worksheet

Dim LastRowSource As Long

Dim LastRowDestination As Long

Dim i As Integer

Dim NextEmptyRow As Long

Dim NextEmptyRowPlusOneRow As Long

Dim HeaderCopied As Boolean ‘ Flag to track if the header has been copied

 

‘ Set the source and destination worksheets

Set wsDestination = ThisWorkbook.Sheets(“CombinedData”) ‘ Replace “CombinedData” with the name of your destination sheet

NextEmptyRow = 5 ‘ Start with row 5 for the header

NextEmptyRowPlusOneRow = 6 ‘ Start with row 6 for the freeze panes

HeaderCopied = False ‘ Initialize the flag

 

‘ Loop through each source sheet

For Each wsSource In ThisWorkbook.Sheets

‘ Exclude the destination sheet and any other sheets you don’t want to combine

If wsSource.Name <> wsDestination.Name Then

‘ Find the last row in the source sheet

LastRowSource = wsSource.Cells(wsSource.Rows.Count, “A”).End(xlUp).Row

 

‘ Copy headers from the first source sheet only if not already copied

If Not HeaderCopied Then

wsSource.Range(“A1:O1”).Copy wsDestination.Cells(NextEmptyRow, 1)

 

‘ Set the row height for the header row (adjust the value as needed)

wsDestination.Rows(NextEmptyRow).RowHeight = 30 ‘ You can adjust the height as needed

 

 

‘ Freeze the header row

ActiveWindow.FreezePanes = False ‘ Unfreeze panes

wsDestination.Activate

wsDestination.Rows(NextEmptyRowPlusOneRow).Select

ActiveWindow.FreezePanes = True

 

‘ Adjust column widths based on the first source sheet’s column widths

For i = 1 To wsSource.Cells(1, Columns.Count).End(xlToLeft).Column

wsDestination.Columns(i).ColumnWidth = wsSource.Columns(i).ColumnWidth

Next i

 

HeaderCopied = True ‘ Set the flag to indicate the header has been copied

NextEmptyRow = NextEmptyRow + 1 ‘ Increment to start data from row 6

End If

VBA code for button Delete Combined Data

Sub DeleteRowsFromRow5Onwards()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets(“CombinedData”) ‘ Replace “CombinedData” with the name of your sheet

 

‘ Determine the last used row in the worksheet

Dim LastRow As Long

LastRow = ws.Cells(ws.Rows.Count, “A”).End(xlUp).Row

 

‘ Check if there are rows to delete

If LastRow >= 5 Then

‘ Delete rows from row 5 onwards

ws.Rows(“5:” & LastRow).Delete

End If

End Sub

‘ Copy data from the source sheet to the destination sheet

wsSource.Range(“A2:O” & LastRowSource).Copy wsDestination.Cells(NextEmptyRow, 1)

NextEmptyRow = NextEmptyRow + (LastRowSource – 1) ‘ Update the next empty row

End If

Next wsSource

End Sub

 

FB Tags:

#mindstormGR #data_manipulation #excel_tips #vba_projects #excel_automation