Extracting rows from excel
Solved/Closed
Teke
-
Jan 27, 2016 at 06:43 PM
vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 - Feb 1, 2016 at 04:48 PM
vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 - Feb 1, 2016 at 04:48 PM
Related:
- Extracting rows from excel
- Excel marksheet - Guide
- Number to words in excel - Guide
- Excel apk for pc - Download - Spreadsheets
- Kernel for excel - Download - Backup and recovery
- Gif in excel - Guide
1 response
vcoolio
Posts
1411
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
September 6, 2024
262
Feb 1, 2016 at 05:33 AM
Feb 1, 2016 at 05:33 AM
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):-
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.
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.
Feb 1, 2016 at 04:16 PM
Thank you very much for your time and help. You really made my life easier.
Feb 1, 2016 at 04:48 PM
You're welcome. Glad that I could help.
Cheerio,
vcoolio.