Forum Discussion
clmartin87
Feb 24, 2023Copper Contributor
Copying master sheet rows to sheets based on column - modify VBA to only copy new added rows?
I have a 'master sheet' that gets added to (by copying new rows to it) on a monthly basis (100's of rows per month). I was able to build a module that adds a sheet and copies rows to the new sheet ba...
- Feb 24, 2023
There is only a slight modification to your code and it works in the attached file if an identifier is added in column I. Let's say that the newly added rows of data are in range A100:H250. Then i add e.g. an "x" as identifier in cell I100 since 100 is the start row of the added data. Your code then only adds the data from A100:H250 to the already existing sheets.
Sub Copy_Rows() Dim r1 As Range, Row_Last, Row_First As Long, sht As Worksheet Dim Row_Last1 As Long Dim RangeName As String Dim src As Worksheet 'source sheet Set src=Sheets("DirPrnInfo_CD's Cleaned") Row_Last = src.Cells(Cells.Rows.Count, "A").End(xlUp).Row Row_First = src.Cells(Cells.Rows.Count, "I").End(xlUp).Row If Row_First = 1 Then Row_First = 2 Else End If RangeName = "A" & Row_First & ":A" & Row_Last For Each r1 In src.Range(RangeName) On Error Resume Next Set sht = Sheets(CStr(r1.Value)) On Error GoTo 0 If sht Is Nothing Then Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = CStr(r1.Value) 'Sheets(CStr(r.Value)).Cells(1, 1) = "Total" Row_Last1 = Sheets(CStr(r1.Value)).Cells(Cells.Rows.Count, "A").End(xlUp).Row src.Rows(r1.Row).Copy Sheets(CStr(r1.Value)).Cells(Row_Last1 + 1, 1) Sheets(CStr(r1.Value)).Cells(1, 2) = WorksheetFunction.Sum(Sheets(CStr(r1.Value)).Columns(8)) Set sht = Nothing Else 'Sheets(CStr(r.Value)).Cells(1, 1) = "Total" Row_Last1 = Sheets(CStr(r1.Value)).Cells(Cells.Rows.Count, "A").End(xlUp).Row src.Rows(r1.Row).Copy Sheets(CStr(r1.Value)).Cells(Row_Last1 + 1, 1) Sheets(CStr(r1.Value)).Cells(1, 2) = WorksheetFunction.Sum(Sheets(CStr(r1.Value)).Columns(8)) Set sht = Nothing End If Next r1 End Sub
OliverScheurich
Feb 24, 2023Gold Contributor
There is only a slight modification to your code and it works in the attached file if an identifier is added in column I. Let's say that the newly added rows of data are in range A100:H250. Then i add e.g. an "x" as identifier in cell I100 since 100 is the start row of the added data. Your code then only adds the data from A100:H250 to the already existing sheets.
Sub Copy_Rows()
Dim r1 As Range, Row_Last, Row_First As Long, sht As Worksheet
Dim Row_Last1 As Long
Dim RangeName As String
Dim src As Worksheet
'source sheet
Set src=Sheets("DirPrnInfo_CD's Cleaned")
Row_Last = src.Cells(Cells.Rows.Count, "A").End(xlUp).Row
Row_First = src.Cells(Cells.Rows.Count, "I").End(xlUp).Row
If Row_First = 1 Then
Row_First = 2
Else
End If
RangeName = "A" & Row_First & ":A" & Row_Last
For Each r1 In src.Range(RangeName)
On Error Resume Next
Set sht = Sheets(CStr(r1.Value))
On Error GoTo 0
If sht Is Nothing Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = CStr(r1.Value)
'Sheets(CStr(r.Value)).Cells(1, 1) = "Total"
Row_Last1 = Sheets(CStr(r1.Value)).Cells(Cells.Rows.Count, "A").End(xlUp).Row
src.Rows(r1.Row).Copy Sheets(CStr(r1.Value)).Cells(Row_Last1 + 1, 1)
Sheets(CStr(r1.Value)).Cells(1, 2) = WorksheetFunction.Sum(Sheets(CStr(r1.Value)).Columns(8))
Set sht = Nothing
Else
'Sheets(CStr(r.Value)).Cells(1, 1) = "Total"
Row_Last1 = Sheets(CStr(r1.Value)).Cells(Cells.Rows.Count, "A").End(xlUp).Row
src.Rows(r1.Row).Copy Sheets(CStr(r1.Value)).Cells(Row_Last1 + 1, 1)
Sheets(CStr(r1.Value)).Cells(1, 2) = WorksheetFunction.Sum(Sheets(CStr(r1.Value)).Columns(8))
Set sht = Nothing
End If
Next r1
End Sub
- clmartin87Feb 25, 2023Copper ContributorThis worked like a champ! Simple solution, very 'elegant'!
Thanks, Curtis