Copy rows to new sheets if condition is met
Solved/Closed
I.Gal
Posts
4
Registration date
Wednesday May 17, 2017
Status
Member
Last seen
May 23, 2017
-
Updated on May 17, 2017 at 07:06 AM
vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 - May 24, 2017 at 12:58 AM
vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 - May 24, 2017 at 12:58 AM
Related:
- Excel copy data from one sheet to another if a condition is met
- Transfer data from one excel worksheet to another automatically - Guide
- Mark sheet in excel - Guide
- How to screenshot excel sheet - Guide
- How to open excel sheet in notepad++ - Guide
- Google sheet right to left - Guide
4 responses
vcoolio
Posts
1411
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
September 6, 2024
262
May 17, 2017 at 06:47 AM
May 17, 2017 at 06:47 AM
Hello I.Gal,
I assume that you have a problem with the code that you posted so try the following code instead (untested):-
Place the code in a standard module and assign it to a button.
The code will create new sheets for each unique value in Column AL and then transfer the relevant rows of data to their individual sheets.
I hope that this helps.
Cheerio,
vcoolio.
I assume that you have a problem with the code that you posted so try the following code instead (untested):-
Option Explicit Sub CreateSheetsTransferData() Dim ar As Variant Dim i As Integer Dim lr As Long Dim ws As Worksheet Dim sh As Worksheet Application.ScreenUpdating = False lr = Range("A" & Rows.Count).End(xlUp).Row Set sh = Sheet1 ar = sh.Range("AL2", sh.Range("AL" & sh.Rows.Count).End(xlUp)) For i = LBound(ar) To UBound(ar) If Not Evaluate("ISREF('" & ar(i, 1) & "'!A1)") Then Worksheets.Add(After:=Sheets(Sheets.Count)).Name = ar(i, 1) End If Set ws = Worksheets(CStr(ar(i, 1))) sh.Range("AL1:AL" & lr).AutoFilter 1, ar(i, 1) sh.Range("A1", sh.Range("AL" & sh.Rows.Count).End(xlUp)).Copy ws.[A1] ws.Columns.AutoFit Next i sh.[AL1].AutoFilter Application.CutCopyMode = False Application.ScreenUpdating = True sh.Select MsgBox "All done!", vbExclamation, "STATUS" End Sub
Place the code in a standard module and assign it to a button.
The code will create new sheets for each unique value in Column AL and then transfer the relevant rows of data to their individual sheets.
I hope that this helps.
Cheerio,
vcoolio.
May 18, 2017 at 01:26 AM
Thank you for you quick response and help, it works great, I just have one question-
what should I change in order to enable all columns to be copied ? (only columns A:AL are cpoied but there are more columns in the table)
Once again, thank you.