COPY AND PASTE VALUE - CELLS WITH SPECIFIC VALUES USING A MACRO

[Lisa Rose]

I have a file that pulls information from other sheets to compile information for management. The sheet is now 2+ years old and I want to copy and paste values for older years to decrease the size of the file.

Here is a sample of my spread sheet

10989

I want to copy and paste values for all rows containing "2012".

I would like to do this using a macro that I can change 2012 to 2013 etc. each year. Then the sheets for each year can also be deleted.

[ashleyuk1984]

This task is easy, but I require a bit more information.
Are you just copying cells from columns J & K ?? Or the entire row??

Just off the top of my head, I would achieve this by doing this...




Sub CopyCells()

LastRow = Range("H65536").End(xlUp).Row
x = 1
y = 1


Do Until x = LastRow + 1
If Range("H" & x).value = "2012" Then
Range("J" & x, "K" & x).Copy
Sheets("Sheet2").Range("A" & y).PasteSpecial xlPasteValuesAndNumberFormats
y = y + 1
End If
Loop

End Sub

[ashleyuk1984]

Whoops forgot to increment "x"




SubCopyCells()

LastRow = Range("H65536").End(xlUp).Row
x = 1
y = 1

Do Until x = LastRow + 1
If Range("H" & x).value = "2012" Then
Range("J" & x, "K" & x).Copy
Sheets("Sheet2").Range("A" & y).PasteSpecial xlPasteValuesAndNumberFormats
y = y + 1
End If
x = x + 1
Loop

End Sub

[snb]

That's why MS developed autofilter for Excel.
Always start with builtin facilities.

[Lisa Rose]

Whoops forgot to increment "x"




SubCopyCells()

LastRow = Range("H65536").End(xlUp).Row
x = 1
y = 1

Do Until x = LastRow + 1
If Range("H" & x).value = "2012" Then
Range("J" & x, "K" & x).Copy
Sheets("Sheet2").Range("A" & y).PasteSpecial xlPasteValuesAndNumberFormats
y = y + 1
End If
x = x + 1
Loop

End Sub




The entire row would work as best, but definitely need columns H though AU.

[ashleyuk1984]

For entire row.




Sub CopyCells()

LastRow = Range("H65536").End(xlUp).Row
x = 1
y = 1

Do Until x = LastRow + 1
If Range("H" & x).Value = "2012" Then
Range("H" & x).EntireRow.Copy
Sheets("Sheet2").Range("A" & y).PasteSpecial xlPasteValuesAndNumberFormats
y = y + 1
End If
x = x + 1
Loop

End Sub



For just columns H through to AU




Sub CopyCells()

LastRow = Range("H65536").End(xlUp).Row
x = 1
y = 1

Do Until x = LastRow + 1
If Range("H" & x).Value = "2012" Then
Range("H" & x, "AU" & x).Copy
Sheets("Sheet2").Range("A" & y).PasteSpecial xlPasteValuesAndNumberFormats
y = y + 1
End If
x = x + 1
Loop

End Sub

[fredlo2010]

Perhaps something like this:


Option ExplicitSub SumarizeYears()


Dim lYear As String
Dim lOffSet As Long
Dim sh As Worksheet


Set sh = Sheets("Data") ' <--change to the name of the sheet where the data is.
lYear = InputBox("Please enter the year you want to work with.", "Pick A Year")


'Check that its a valid year
If Len(lYear) = 4 And Not IsNumeric(lYear) Then GoTo InvalidYear


' create a filter with the data from the inputbox
sh.Range("H3").CurrentRegion.AutoFilter Field:=8, Criteria1:=lYear
If WorksheetFunction.CountA(sh.Range("H:H").SpecialCells(xlCellTypeVisible)) Then GoTo CleanUp


' check if there is a sheet with the name of the year
If SheetExists(lYear) = False Then
'Add a new sheet with that name
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = lYear

'copy titles
sh.Range("A3").Resize(, sh.Range("H3").CurrentRegion.Columns.Count).Copy Destination:=Sheets(lYear).Range("A1")
End If


' Copy the data from the master sheet to the individualsheet
sh.Range("H3").CurrentRegion.Offset(1, 0).Copy
Sheets(lYear).Range("A" & Sheets(lYear).Cells(Rows.Count, "H").End(xlUp).Row + 1).PasteSpecial xlPasteValues


' Delete the rows
sh.Range("H3").CurrentRegion.Offset(1, 0).EntireRow.Delete


' Remove the filter and select first cell
CleanUp:
sh.Range("H3").CurrentRegion.AutoFilter
sh.Select
Range("A1").Select
Exit Sub


InvalidYear:
MsgBox "The yeat enetered is invalid. Please enter a valid year to proceed." & vbCr & _
"This macro will exit now.", vbOKOnly + vbInformation, "Invalid Year"
Exit Sub


End Sub


Function SheetExists(ByVal sName As String) As Boolean

Dim sh As Worksheet

On Error Resume Next
Set sh = Sheets(sName)

If Err.Number = 0 Then SheetExists = True
On Error GoTo 0

End Function

Thanks

[SamT]

Alfredo,

Nice. Now refactor it with a main sub that finds all the unique years, loops thru them and Calls SummarizeYears() for each year. :devil2:

Bonus grade points :D Put the new sheets into a new workbook.

[riham]

Thank you so much!