Excel Macro - Copy / Paste into new workbook only Select Visible rows

Hello Experts,

I have created a XLSM file that import TXT files, clean the importation, merge it into sheet "Analysis" and then apply a conditional formatting on Duplicates Values.  I see what I need to work (my columns heading and duplicates PC in Column A with additional information in column B & C).  Now to finish my "preparation" for "analysis", I would like to copy / paste the headers and only selected visible rows into a new workbook.  Can you help me with that macro?

The new workbook would be name "Analysis - Duplicate PC - yyyy-mm-dd.xlsx"  where yyyy-mm-dd would be the current date.

I have attached a sample of my workbook.
duplicate.xlsx
mldaigle1Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Maybe this....
Sub CopyVisibleRowsToAnotherSheet()
Dim Dwb As Workbook
Dim sws As Worksheet
Dim lr As Long
Dim DwbName As String
Dim DwbPath As String

Application.ScreenUpdating = False
Set sws = Sheets("Sheet1")
lr = sws.Cells(Rows.Count, 1).End(xlUp).Row

DwbPath = ThisWorkbook.Path
DwbName = "Analysis - Duplicate PC " & Format(Date, "yyyy-mm-dd") & ".xlsx"

sws.Range("A1:A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy

Workbooks.Add
Set Dwb = ActiveWorkbook
ActiveSheet.Paste
Application.DisplayAlerts = False
Dwb.SaveAs DwbPath & "\" & DwbName
Dwb.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Finished.", vbInformation
End Sub

Open in new window

0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Forgot to add comments in the code. Please make the changes are per your requirement.
Sub CopyVisibleRowsToAnotherSheet()
Dim Dwb As Workbook
Dim Sws As Worksheet
Dim lr As Long
Dim DwbName As String
Dim DwbPath As String

Application.ScreenUpdating = False
Set Sws = Sheets("Sheet1")                  'Sws is the source sheet of source workbook i.e. macro workbook
lr = Sws.Cells(Rows.Count, 1).End(xlUp).Row     'Finding the last row with data in col. A of source sheet.

DwbPath = ThisWorkbook.Path     'Destination workbook path. It will be same as the path of macro workbook.
DwbName = "Analysis - Duplicate PC " & Format(Date, "yyyy-mm-dd") & ".xlsx"         'Destination workbook's name

Sws.Range("A1:A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy           'Copying visible rows only

Workbooks.Add           'Creating a new workbook
Set Dwb = ActiveWorkbook
ActiveSheet.Paste        'Pasting on the first sheet of newly created destination workbook
Application.DisplayAlerts = False
Dwb.SaveAs DwbPath & "\" & DwbName      'Saving the destination workbook
Dwb.Close                                                 'Closing the destination workbook
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Finished.", vbInformation
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mldaigle1Author Commented:
Hi sktneer,

That macro works perfectly.  I just finished my master file, added a line to close the active workbook without saving and bang!  All done, ready to analyze the duplicate pc.

You were a great help!

Have a wonderful weekend,

/mldaigle

and here you go, another kiss for you!  xxx
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome mld! Glad I was able to help.

And thanks for the kiss again, I am getting them from you on a regular basis. :) :) :)
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.