Hi,
I have a code shown below that sets out to do two things:
1. Copy and paste data from a source workbook to a destination workbook.
2. Group the data by Type (Small/ Large) by inserting 5 blank rows after the first empty row of Type1(Small) and then inserting similar headers for Type2(Large). The headers for Type1(Small) are set
Stage 1 of the code works OK. However I am having problems with Stage2. Nothing happens! I have been tinkering around with it pulling snippets of code found on the forum to no avail. Any help would be much appreciated.
I have highlighted the problem area of the code in red and provided some sample data of what I am trying to achieve immediately below.
<tbody>
</tbody>
<tbody>
</tbody>
Here is my code
(Problem area highlighted in red)
Sub Test()
Application.DisplayAlerts = False
Application.EnableEvents = True
Dim Grp As Workbook
Dim Lastrow As Integer
Dim fnRange As Range
Dim i As Integer
Dim erow As Integer
Dim Month As String
Dim finalRow As Integer
Month = "Nov"
Lastrow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To Lastrow
Set fnRange = Cells.Find("Small", Cells(8), xlValues, , xlByColumns)
If Cells(i, 1) = 2 Then
Worksheets("Grp").Range(Cells(i, 2), Cells(i, 9)).Select
Selection.Copy
Workbooks.Open Filename:="C:\Users\YV\Desktop\VBA\TestBook.xlsx"
Worksheets(Month).Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 1).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.PasteSpecial
Set fnRange = Cells.Find("Small", Cells(8), xlValues, , xlByColumns)
Rows(fnRange.Row + 1 & "1:1" & fnRange.Row + 5).Insert
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If
Next i
End Sub
I have a code shown below that sets out to do two things:
1. Copy and paste data from a source workbook to a destination workbook.
2. Group the data by Type (Small/ Large) by inserting 5 blank rows after the first empty row of Type1(Small) and then inserting similar headers for Type2(Large). The headers for Type1(Small) are set
Stage 1 of the code works OK. However I am having problems with Stage2. Nothing happens! I have been tinkering around with it pulling snippets of code found on the forum to no avail. Any help would be much appreciated.
I have highlighted the problem area of the code in red and provided some sample data of what I am trying to achieve immediately below.
Sample data: Stage 1 | |
| Group | Type |
| B | Small |
| B | Small |
| B | Large |
| B | Large |
| B | Large |
| B | Large |
| B | Large |
| B | Large |
| B | Large |
| B | Large |
<tbody>
</tbody>
Stage 2 | |
| Group | Type |
| B | Small |
| B | Small |
| Group | Type |
| B | Large |
| B | Large |
| B | Large |
| B | Large |
| B | Large |
| B | Large |
| B | Large |
| B | Large |
<tbody>
</tbody>
Here is my code
(Problem area highlighted in red)
Sub Test()
Application.DisplayAlerts = False
Application.EnableEvents = True
Dim Grp As Workbook
Dim Lastrow As Integer
Dim fnRange As Range
Dim i As Integer
Dim erow As Integer
Dim Month As String
Dim finalRow As Integer
Month = "Nov"
Lastrow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To Lastrow
Set fnRange = Cells.Find("Small", Cells(8), xlValues, , xlByColumns)
If Cells(i, 1) = 2 Then
Worksheets("Grp").Range(Cells(i, 2), Cells(i, 9)).Select
Selection.Copy
Workbooks.Open Filename:="C:\Users\YV\Desktop\VBA\TestBook.xlsx"
Worksheets(Month).Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 1).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.PasteSpecial
Set fnRange = Cells.Find("Small", Cells(8), xlValues, , xlByColumns)
Rows(fnRange.Row + 1 & "1:1" & fnRange.Row + 5).Insert
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If
Next i
End Sub
