Report

Extracting rows from excel [Solved]

Ask a question Teke - Latest answer on Feb 1, 2016 04:48PM
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
moins plus
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.
Teke- Feb 1, 2016 04:16PM
Dear vcoolio,
Thank you very much for your time and help. You really made my life easier.
Reply
vcoolio 785Posts Thursday July 24, 2014Registration date ModeratorStatus September 19, 2016 Last seen - Feb 1, 2016 04:48PM
Hello Teke,

You're welcome. Glad that I could help.

Cheerio,
vcoolio.
Reply
Add comment

Members get more answers than anonymous users.

Being a member gives you detailed monitoring of your requests.

Being a member gives you additional options.

Not a member yet?

sign-up, it takes less than a minute and it's free!