Copy rows to new sheets if condition is met
Solved/Closed
I.Gal
vcoolio
- Posts
- 6
- Registration date
- Wednesday May 17, 2017
- Status
- Member
- Last seen
- May 23, 2017
vcoolio
- Posts
- 1355
- Registration date
- Thursday July 24, 2014
- Status
- Moderator
- Last seen
- August 10, 2022
Related:
- Excel copy data from one sheet to another if a condition is met
- Excel copy row to another sheet if condition is met - Best answers
- Copy cell if condition is met excel - Best answers
- How to copy a data from one sheet to another, when specific criteria is met - Forum - Excel
- Copy Potential data from one sheet to another if condition met - Forum - Excel
- Copy data from one excel sheet to another: automatically - Guide
- How to copy data based on criteria met ✓ - Forum - Excel
- Copying data from one Excel sheet to another. ✓ - Forum - Excel
4 replies
vcoolio
May 17, 2017 at 06:47 AM
- Posts
- 1355
- Registration date
- Thursday July 24, 2014
- Status
- Moderator
- Last seen
- August 10, 2022
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.