Copy a selected range of data

Please email me an I will send the file that does as you requested.
I is too big to attach here.
to make the district sheets go Tools> copy to district sheets.
to delete the district sheets go to Tools> delete district sheets.

Try the following code:

PHP Code: 

Option Explicit
Sub Distributor()
          Dim DATA_SHEET As Worksheet
          Dim sDistrictName As String, sTempName As String, COPY_AFTER_SHEET As String
          Dim rStartRow As Range, rEndRow As Range
          Dim iStartRow As Integer, iEndRow As Integer, LCount As Integer, NextDistrict_Pointer As Integer
          '-----------------------------------------------------------------------------------------'
          Set DATA_SHEET = Sheets("Data")
          
          DATA_SHEET.Select
          DATA_SHEET.Range("B2").Select
          NextDistrict_Pointer = 2
          COPY_AFTER_SHEET = "Data"
          
          While DATA_SHEET.Range("B" & NextDistrict_Pointer).Value > ""
                    DATA_SHEET.Select
                    Range("B" & NextDistrict_Pointer).Select
                    sDistrictName = ActiveCell.Value
                    sTempName = ActiveCell.Offset(1, 0).Value
                    LCount = 1
                    iStartRow = ActiveCell.Row
          
                    While sTempName = sDistrictName
                              LCount = LCount + 1
                              sTempName = ActiveCell.Offset(LCount, 0).Value
                    Wend
                    iEndRow = ActiveCell.Offset(LCount - 1, 0).Row
                    
                    Call CreateDistrictSheet(sDistrictName, COPY_AFTER_SHEET)
                    Call CopyData2District(sDistrictName, iStartRow, iEndRow)
                    NextDistrict_Pointer = iEndRow + 1
                    COPY_AFTER_SHEET = sDistrictName
          Wend
End Sub
Sub CreateDistrictSheet(ByVal TabName As String, sLastSheetName As String)
          Dim iCount As Integer
          Dim NewSheet As Worksheet
          Set NewSheet = Sheets.Add
          NewSheet.Name = TabName
          Worksheets(TabName).Range("A1") = Worksheets("Data").Range("A1").Value
          Worksheets(TabName).Range("B1:E1").Value = Worksheets("Data").Range("C1:F1").Value
          Worksheets(TabName).Move after:=Worksheets(sLastSheetName)
End Sub
Sub CopyData2District(ByVal sTHIS_DISTRICT As String, ByVal iFirstRow As Integer, ByVal iLastRow As Integer)
          Dim Src_Row_Pointer As Integer, Dst_Col_Pointer As Integer, Dst_Row_Pointer As Integer
          Dim THIS_SHEET As Worksheet, SRC_DATA_SHEET As Worksheet
          
          Set SRC_DATA_SHEET = Worksheets("Data")
          Set THIS_SHEET = Worksheets(sTHIS_DISTRICT)
          Dst_Row_Pointer = 2
          
          With THIS_SHEET
                    For Src_Row_Pointer = iFirstRow To iLastRow
                              .Range("A" & Dst_Row_Pointer).Value = SRC_DATA_SHEET.Range("A" & Src_Row_Pointer).Value
                              For Dst_Col_Pointer = 2 To 5
                                        .Cells(Dst_Row_Pointer, Dst_Col_Pointer).Value = SRC_DATA_SHEET.Cells(Src_Row_Pointer, Dst_Col_Pointer + 1).Value
                              Next Dst_Col_Pointer
                              Dst_Row_Pointer = Dst_Row_Pointer + 1
                    Next Src_Row_Pointer
          End With 'THIS_SHEET'
End Sub 


I need more specific information. As I understand you so far, you do not want to create any new sheets; but, you want to copy to an existing sheet. How is the destination sheet determined? Is there something about the value of the data that tells where it should go?