Copy two sheets data in new work book with two sheets.

Dear Concern,

We have tried the below code. but, it is not giving any "debug" and not stopping as well.
besides sometimes it is creating an .PDF file and giving each cell in a separate page instead of single page.

Please check and help us.

Note: our actual Book is different. I am trying to get the sample code or logic. to get the details in a new workbook with two sheets from the working workbook.


Sub Macro1()

Sheets("Consolidated file").Select

Dim a As Integer

Dim i As Long

Dim xlsname As String

Dim NewName As String

Dim nm As Name

Dim ws As Worksheet

Range("A1:GY1").Select

Range(Selection, Selection.End(xlToRight)).Select

Selection.AutoFilter

Selection.End(xlToLeft).Select

Range("HA1").Select

If Len(Dir("C:\Users\mine\Desktop\" & currentdate, vbDirectory)) = 0 Then

MkDir "C:\Users\mine\Desktop\" & currentdate

End If

Set r1search = Sheets("Consolidated file").Range("HA1", Range("HA200000").End(xlUp))

For Each HA In r1search

For a = 2 To Sheets("Sheet2").Range("E1").Value

Range("HA1").AutoFilter Field:=207, Criteria1:=Val(a)

Lc = Application.VLookup(Val(a), Std.Range("B2:C1000"), 2, 0)

'If Len(Dir("C:\Users\mine\Desktop" & currentdate & "\" & "Student1 Report" & Lc & ".xls", vbDirectory)) = 0 Then

If Sheets("Data Entry - Output").Range("AG2").Value = 1 Then

With Application

.ScreenUpdating = False

'Copy specific sheets ; *SET THE SHEET NAMES TO COPY BELOW*;Array("Sheet Name", "Another sheet name", "And Another")); Sheet names go inside quotes, seperated by commas

On Error GoTo ErrCatcher

Sheets(Array("Student Details - Format", "Subject Details")).Copy

On Error GoTo 0

'Paste sheets as values ;Remove External Links, Hyperlinks and hard-code formulas; Make sure A1 is selected on all sheets

For Each ws In ActiveWorkbook.Worksheets

ws.Cells.Copy

ws.[A1].PasteSpecial Paste:=xlValues

ws.Cells.Hyperlinks.Delete

Application.CutCopyMode = False

Cells(1, 1).Select

ws.Activate

Next ws

Cells(1, 1).Select

'Remove named ranges ; Input box to name new file

NewName = InputBox("Please Specify the name of your new workbook", "New Copy")

'save it with the NewName and in the same directory as original

ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xlsx"

ActiveWorkbook.Close SaveChanges:=False

.ScreenUpdating = True

End With


ErrCatcher:

MsgBox "Specified sheets do not exist within this workbook"

xlsname = "C:\Users\mine\Desktop\" & currentdate & "\" & "Student1 Reports" & ".xls"

If a = Sheets("Std").Range("E1").Value Then

Range("A1:gy1").Select

Range(Selection, Selection.End(xlToRight)).Select

Selection.AutoFilter

Selection.End(xlToLeft).Select

Range("A1").Select

MsgBox "Audit Reports Generation Completed"


Exit Sub

End If

End If

Next a

Next

Exit Sub

End Sub

Dear Concern,

Please provide me the logic which i requested.

Dear the one who is asking for help,

You are selecting cell A1 every time? Change the value with a loop variable.

Dear Concern,

Here my idea is:
A1 is my header. if run the logic it should "subfilter" and select entire details of the Unique Id "123" and paste in new workbook;select entire details of the Unique Id "124" and paste in new workbook;select entire details of the Unique Id "125" and paste in new workbook.

UniqueId Hlt No Std Name Subj Max Marks Min Marks Marks Obtain Percentage
123 1231231 ABC Subject 1 150 35 50 33%
123 1231231 ABC Subject 2 150 35 60 40%
123 1231231 ABC Subject 3 150 35 70 47%
124 1241232 DEF Subject 1 150 35 65 43%
124 1241232 DEF Subject 2 150 35 55 37%
124 1241232 DEF Subject 3 150 35 45 30%
125 1251233 GHI Subject 1 150 35 45 30%
125 1251233 GHI Subject 2 150 35 66 44%
125 1251233 GHI Subject 3 150 35 58 39%

OK, so do you know how to get values out of the cell ,and compare them to the previous value?

Here is an example of that:

dim therowcount, therange

for therowcount = 1 to 10 step 2 'we are counting by twos! 1,3 5, 7, 9

theOldrange = "A" & therowcount
theNewrange = "A" & therowcount + 1
oldval = ThisWorkBook.Worksheets("Sheet1").Range(theOLDrange).value
newval = ThisWorkBook.Worksheets("Sheet1").Range(theNewrange).value
if oldval=newval then
'the two values are the same, so the range should be written to the new sheet
next

That is a solid start. Have FUN!
Post code, and we can help. I am not going to provide you a complete solution, as you will not learn that way, and you will only cut and paste, and tell me it doesn't work. I do not expect it to work as written, but what I expect is for you to have the capacity to look at the example and make it fit into your MODEL!