1,508 questions
Excel VBA: Macro IF loop help needed
Viktoras Ivanenko
1
Reputation point
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.
- 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
- 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
Sign in to answer