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

excel.jpg

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.

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

[riham]

Thank you so much!