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
Attachment 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.
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...
Code:
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
Whoops forgot to increment "x"
Code:
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
That's why MS developed autofilter for Excel.
Always start with builtin facilities.
The entire row would work as best, but definitely need columns H though AU.Quote:
Originally Posted by ashleyuk1984
For entire row.
For just columns H through to AUCode:
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
Code:
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
Perhaps something like this:
Code: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
ThanksCode: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
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.
Thank you so much!