Hello
I am using this macro to split the data from "Daily Data" worksheet into existing soccer Teams worksheets according to the Time of the new data (D column).
Right now, the macro looks for the worksheets of Teams listed in "Daily Data" E column "Home" and add the data based on column D "Time" time of the match.
What I am looking for is to find also for the worksheets of the teams listed in "Daily Data" columna G "Away" and add its data based on column D "Time" time of the match.
The other request is how to copy only the data in the range A:G, to avoid overwriting data in subsequent columns.
Thank you all in advance
edit: This is the sample workbook:
https://www.dropbox.com/s/rfa83cxkciwc68f/Prueba añadir datos nuevos.xlsb?dl=0
I am using this macro to split the data from "Daily Data" worksheet into existing soccer Teams worksheets according to the Time of the new data (D column).
Right now, the macro looks for the worksheets of Teams listed in "Daily Data" E column "Home" and add the data based on column D "Time" time of the match.
What I am looking for is to find also for the worksheets of the teams listed in "Daily Data" columna G "Away" and add its data based on column D "Time" time of the match.
The other request is how to copy only the data in the range A:G, to avoid overwriting data in subsequent columns.
Thank you all in advance
edit: This is the sample workbook:
https://www.dropbox.com/s/rfa83cxkciwc68f/Prueba añadir datos nuevos.xlsb?dl=0
Code:
Sub SplitData()
Const NameCol = "E"
Const HeaderRow = 1
Const FirstRow = 2
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim SrcRow As Long
Dim lastRow As Long
Dim TrgRow As Long
Dim Team As String
'Application.ScreenUpdating = False
Set SrcSheet = ActiveWorkbook.Worksheets("Daily Data")
lastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
For SrcRow = FirstRow To lastRow
Team = SrcSheet.Cells(SrcRow, NameCol).Value
Set TrgSheet = Nothing
On Error GoTo Handler
Set TrgSheet = Worksheets(Team)
TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
If Application.CountIf(TrgSheet.Range("D:D"), SrcSheet.Cells(SrcRow, "D").Value) > 0 Then
MsgBox "Duplicate Detected for " & SrcSheet.Cells(SrcRow, "D").Value
Else
SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
End If
Handler:
Next SrcRow
'Application.ScreenUpdating = True
End Sub
Last edited: