Report

Extracting rows from excel [Solved/Closed]

Ask a question Teke - Last answered on Feb 1, 2016 at 04:48 PM by vcoolio
Hi there,
I have an excel sheet with a very large data. I want to extract different rows and write them in to different sheets of the same excel (or a new excel) file. Can anyone help me please? Below is the sample data. I want to copy each "Chrom" type (1A...7D) in to a new sheet. Thank you so much for your help.

Name Chrom x y z
1 1A B B B
2 1B B B A
3 1D B B B
4 2A B B B
5 2B B B B
6 2D B B A
7 3A B A A
8 3B B B B
9 3D A A A
10 4A A A A
11 4B B B B
12 4D B B B
13 5A B B B
14 5B B B B
15 5D A A A
16 6A A A A
17 6B B B B
18 6D B B B
19 7A A A A
20 7B B B B
21 7D A A A
See more 
Helpful
+2
plus moins
Hello Teke,

I'm assuming that you would like a new sheet created for each "chrom" value and the relevant row of data transferred to each individual sheet. If so, try the following code (in a copy of your work book first):-

Sub CreateSheetsCopyData()

Application.ScreenUpdating = False

        Dim ar As Variant
        Dim i As Integer
        Dim LR As Long
        Dim c As Range
        Dim ws As Worksheet
        Dim Mysheet As String
        
LR = Range("A" & Rows.Count).End(xlUp).Row
ar = Array("1A", "1B", "1D", "2A", "2B", "2D", "3A", "3B", "3D", "4A", "4B", "4D", "5A", "5B", "5D", "6A", "6B", "6D", "7A", "7B", "7D")


For Each c In Range("B2:B" & LR)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(c.Value)
        If ws Is Nothing Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
        End If
  Next c
  
Sheet1.Select
  For i = 0 To UBound(ar)
         Sheets(ar(i)).UsedRange.ClearContents
         Range("B1", Range("B" & Rows.Count).End(xlUp)).AutoFilter 1, ar(i)
         Range("A1", Range("E" & Rows.Count).End(xlUp)).Copy Sheets(ar(i)).Range("A" & Rows.Count).End(xlUp)
    Next i
   [B1].AutoFilter
 
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "Data transfer completed!", vbExclamation, "Status"

End Sub
 


Following is a link to my test work book for you to peruse. To run the code, Pess Alt + F8 to open the macro window then click on run.

https://www.dropbox.com/s/zjkkxceroy3e24i/Teke.xlsm?dl=0

I hope that this helps.

Cheerio,
vcoolio.
Was this answer helpful?  
Teke- Feb 1, 2016 at 04:16 PM
Dear vcoolio,
Thank you very much for your time and help. You really made my life easier.
vcoolio 1041Posts Thursday July 24, 2014Registration date ModeratorStatus August 19, 2017 Last seen - Feb 1, 2016 at 04:48 PM
Hello Teke,

You're welcome. Glad that I could help.

Cheerio,
vcoolio.

Member requests are more likely to be responded to.

Members can monitor the statuses of their requests from their account pages.

A CCM membership gives you access to additional options.

Not a member yet?

Sign up now. It takes less than a minute and is completely free!