Hi, i have just inherited a macro to consolidate data (from 10 tabs) into one single column B in an output spreadsheet
Module 1 (with respect to tab 2 to 7)
Code
Call copysheet(source, target, "2. Tab", 129, 5)
Call copysheet(source, target, "3. Tab", 415, 4)
Call copysheet(source, target, "4. Tab", 582, 9)
Call copysheet(source, target, "5. Tab", 957, 8)
Call copysheet(source, target, "6. Tab", 1244, 3)
Call copysheet(source, target, "7. Tab", 1317, 7)
Module 2
Code
Sub copysheet(source, target, sheetname, startrange, numgroups)
source.Sheets(sheetname).Activate
source.ActiveSheet.Range("f3:i3").Copy
target.ActiveSheet.Range("b" & startrange).PasteSpecial Transpose:=True
source.ActiveSheet.Range("f7:i7").Copy
target.ActiveSheet.Range("b" & startrange + 5).PasteSpecial Transpose:=True
source.ActiveSheet.Range("j8:k8").Copy
target.ActiveSheet.Range("b" & startrange + 10).PasteSpecial Transpose:=True
Bot = 8
For Group = 1 To numgroups
If numgroups = 8 Then
If Group = 6 Then
Top = Bot + 3
Bot = Top + 16
ElseIf Group = 7 Then
Top = Bot + 4
Bot = Top + 6
Else
Top = source.ActiveSheet.Cells(Bot, 12).End(xlDown).Row
Bot = source.ActiveSheet.Cells(Top, 12).End(xlDown).Row
End If
ElseIf numgroups = 9 Then
If Group = 8 Then
Top = Bot + 3
Bot = Top + 6
Else
Top = source.ActiveSheet.Cells(Bot, 12).End(xlDown).Row
Bot = source.ActiveSheet.Cells(Top, 12).End(xlDown).Row
End If
Else
Top = source.ActiveSheet.Cells(Bot, 12).End(xlDown).Row
Bot = source.ActiveSheet.Cells(Top, 12).End(xlDown).Row
End If
If IsEmpty(source.ActiveSheet.Cells(Top, 6)) Then
numcols = 1
Else
numcols = 7
End If
For Col = 1 To numcols
If numgroups > 8 Then 'condition for sheet 5 (extra row in section 9)
If Group <> numgroups - 1 Then
lrow = Cells(Rows.Count, 2).End(xlUp).Row
Else
lrow = toprow + 1
End If
Else
lrow = Cells(Rows.Count, 2).End(xlUp).Row
End If
Set Rangetop = source.ActiveSheet.Cells(Top, 4 + Col)
Set Rangebot = source.ActiveSheet.Cells(Bot, 4 + Col)
source.ActiveSheet.Range(Rangetop, Rangebot).SpecialCells(xlCellTypeVisible).Copy
target.Sheets("Sheet1").Activate
If Not IsEmpty(Cells(lrow + 2, 1)) Then
If Cells(lrow + 2, 1) <> 1 Then
toprow = lrow + 2
ElseIf Cells(lrow + 3, 1) <> 1 Then
toprow = lrow + 2
Else
toprow = Cells(lrow + 2, 1).End(xlDown).End(xlDown).Row
End If
Else
toprow = lrow + 3
End If
If Col = 1 Then
If numgroups > 7 And Group > numgroups - 5 Then
target.ActiveSheet.Range("B" & toprow).PasteSpecial
Else
End If
Else
target.ActiveSheet.Range("B" & toprow).PasteSpecial
End If
Next Col
Next Group
End SubI am seeking some help to get guidance in terms of what Module 2 is doing from Bot=8 onwards. Any help is greatly appreciated. Thanks