Excel VBA: Macro IF loop help needed

Viktoras Ivanenko 1 Reputation point
2022-05-16T15:28:59.68+00:00

Hi, I`m totally new to VBA and I need some help, please.

I`m trying to create a Macro on excel that would combine different sheets of information into one sheet. I managed to "borrow" some code available online and combine it into something that works but I can't solve some troubles.

  1. Need a code review and suggestions on where is the issue with function looping and copying info from source sheets into destination sheet, instead of just doing one round
  2. Need a suggestion on how to make it paste data not from the first row but from let's say 5th row, I need some space left on top for buttons of macro and so on.

Much appreciated! Here are the code lines:

Sub Combined()

Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstRow As Long
Dim EnRange As String
Dim SrcRng As Range
Set DstSht = Worksheets("PM")

'Loop through each WorkSheet in the workbook and copy the data to the active sheet
For Each Sht In ActiveWorkbook.Worksheets
    If Sht.Name <> DstSht.Name Then
       'Find the last row on the PM sheet
       DstRow = fn_LastRow(DstSht) + 1
       'Find Input data range
       LstRow = fn_LastRow(Sht)
       LstCol = fn_LastColumn(Sht)
       EnRange = Sht.Cells(LstRow, LstCol).Address
       Set SrcRng = Sht.Range("A16:" & EnRange)
       'Copy data to the PM WorkSheet
       SrcRng.Copy Destination:=DstSht.Range("A" & DstRow)
    End If

Next

'Format the PM sheet appearance
DstSht.Range("A1:H1").HorizontalAlignment = xlCenter
DstSht.Columns("A:Z").Interior.Color = RGB(255, 255, 255)
DstSht.Range("A1:H1").Font.Color = RGB(255, 255, 255)
DstSht.Range("A1:H1").Font.Bold = True
DstSht.Range("A1:H1").Interior.Color = RGB(117, 113, 113)
DstSht.Range("A1") = "Item #"
DstSht.Range("B1") = "WS"
DstSht.Range("C1") = "Milestone"
DstSht.Range("D1") = "Start Date"
DstSht.Range("E1") = "End Date"
DstSht.Range("F1") = "Status"
DstSht.Range("G1") = "Delay Date"
DstSht.Range("H1") = "Delay Comment"
DstSht.Columns("A:B").ColumnWidth = 8
DstSht.Columns("C").ColumnWidth = 110
DstSht.Columns("D:G").ColumnWidth = 22
DstSht.Columns("H").ColumnWidth = 30
DstSht.Columns("A:H").AutoFilter
DstSht.Columns("A:H").WrapText = False

End Sub

Function fn_LastRow(ByVal Sht As Worksheet)

    Dim lastRow As Long
    lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
    lRow = Sht.Cells.SpecialCells(xlLastCell).Row
    Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
        lRow = lRow - 1
    Loop
    fn_LastRow = lRow

End Function

Function fn_LastColumn(ByVal Sht As Worksheet)

    Dim lastCol As Long
    lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
    lCol = Sht.Cells.SpecialCells(xlLastCell).Column
    Do While Application.CountA(Sht.Columns(lCol)) = 0 And lCol <> 1
        lCol = lCol - 1
    Loop
    fn_LastColumn = lCol

End Function
Developer technologies | Visual Basic for Applications
0 comments No comments
{count} votes

Your answer

Answers can be marked as Accepted Answers by the question author, which helps users to know the answer solved the author's problem.