Forum Discussion

typhoon1911's avatar
typhoon1911
Copper Contributor
Oct 28, 2020
Solved

copy data to another sheet

Hi Everybody, I am trying to sort this excel file. What I am trying to do is this: In the TYPE column of LR Listing, copy the whole line to another sheet with the same name(s). If I update or ad...
  • Subodh_Tiwari_sktneer's avatar
    Subodh_Tiwari_sktneer
    Oct 28, 2020

    typhoon1911 

     

    By sorting if you mean sorting the Sheet Tabs, you may replace the existing code with the following one...

    Dim wsData      As Worksheet
    
    Sub CopyData()
    Dim wsDest      As Worksheet
    Dim shName      As String
    Dim lr          As Long
    Dim lc          As Long
    Dim dlr         As Long
    Dim Rng         As Range
    Dim Cel         As Range
    
    Application.ScreenUpdating = False
    
    Set wsData = Worksheets("LR Listing")
    lr = wsData.Cells(Rows.Count, "C").End(xlUp).Row
    lc = wsData.UsedRange.Columns.Count
    
    Set Rng = wsData.Range("C2:C" & lr)
    
    For Each Cel In Rng
        If Cel.Value <> "" Then
            shName = Cel.Value
            shName = Replace(Replace(Replace(Replace(Replace(Replace(Replace(shName, ":", ""), "/", ""), "\", ""), "?", ""), "*", ""), "[", ""), "]", "")
            On Error Resume Next
            Set wsDest = Worksheets(shName)
            On Error GoTo 0
            If wsDest Is Nothing Then
                Set wsDest = Worksheets.Add(After:=Worksheets(Worksheets.Count))
                wsDest.Name = shName
            End If
            dlr = wsDest.Cells(Rows.Count, "C").End(xlUp).Row + 1
            wsData.Range(wsData.Cells(Cel.Row, 1), wsData.Cells(Cel.Row, lc)).Copy wsDest.Range("A" & dlr)
        End If
        Set wsDest = Nothing
    Next Cel
    Call SortSheetTabs
    wsData.Activate
    Application.ScreenUpdating = True
    End Sub
    
    Sub SortSheetTabs()
    Dim i As Integer, j As Integer
    
    For i = 2 To Worksheets.Count
        For j = 2 To Worksheets.Count - 1
              If Worksheets(j).Name > Worksheets(j + 1).Name Then
                 Worksheets(j).Move After:=Worksheets(j + 1)
              End If
        Next j
    Next i
    
    End Sub

     

    The code will replace any invalid character which is not allowed in Sheet Name and replace it with nothing.

    What you can do here is, delete all the Sheets except the LR Listing and run the macro which will insert all the tabs with relevant data and sort them in ascending order.

Resources