Copy and paste into new sheet if VBA

[Kads]

Hi,
I have a code (detailed below) which copys and pastes data and formula into a new sheet and creates a new sheet for all different variables in column A. This works fine for copying from one sheet, now I need it to look into the second sheet named "non resources" and do the same but copy and paste both sheets information on to one summary sheet in the same workbook. Any help is much appriciatted.

Private Sub CommandButton1_Click()
Dim thisSheet As String
Dim columnNames As Integer
Dim uniqueRows As Integer
Dim lastRow As Long
Dim shName As String
Application.ScreenUpdating = False

thisSheet = ActiveSheet.Name
lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Range("A3:B3").Select
Selection.UnMerge
Range("A3").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A3:A" & lastRow).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "temp"
ActiveSheet.PasteSpecial
Sheets(thisSheet).Select
Application.CutCopyMode = False
ActiveSheet.ShowAllData
columnNames = 2
Do
    columnNames = columnNames + 1
    
Loop Until Sheets(thisSheet).Cells(3, columnNames + 1) = ""


Do
    uniqueRows = uniqueRows + 1
Loop Until Sheets("temp").Cells(uniqueRows + 1, 1) = ""

For x = 2 To uniqueRows
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Sheets("temp").Cells(x, 1)
    Sheets(thisSheet).Select
    
    Range(Cells(3, 1), Cells(3, columnNames)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter
    ActiveSheet.Range(Cells(3, 1), Cells(lastRow, columnNames)).AutoFilter Field:=1, Criteria1:=Sheets("temp").Cells(x, 1)
    
    'Range(Cells(3, 1), Cells(3, columnNames)).Select
    Application.CutCopyMode = False
    Selection.Copy
    shName = Sheets("temp").Cells(x, 1)
    Sheets(shName).Select
    ActiveSheet.PasteSpecial
    ActiveSheet.Cells(1, 1).Select
    Sheets(thisSheet).Select
    ActiveSheet.ShowAllData
Next x

Sheets("temp").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets(thisSheet).Select
ActiveSheet.Cells(1, 1).Select
Application.ScreenUpdating = True

End Sub

[pike]

hi Kads
You could clean up the code by removing the "Select" method and replacing them with "With" statments

You can loop the two sheets by

For Each xsheet In VBA.Array("Sheetname", non resources")
      Sheets(xsheet).Select
    
    Range(Cells(3, 1), Cells(3, columnNames)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter
    ActiveSheet.Range(Cells(3, 1), Cells(lastRow, columnNames)).AutoFilter Field:=1, Criteria1:=Sheets("temp").Cells(x, 1)
    
    'Range(Cells(3, 1), Cells(3, columnNames)).Select
    Application.CutCopyMode = False
    Selection.Copy
    shName = Sheets("temp").Cells(x, 1)
    Sheets(shName).Select
    ActiveSheet.PasteSpecial
    ActiveSheet.Cells(1, 1).Select
    Sheets(thisSheet).Select
 Next