Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Macro help.
have been given a macro but I need to amend it and wondered if anyone can help. What happens at the mo is Starts in Sheet 1 in a cell that you pick (usually row 7 column A) - Checks that row if it's blank - If it's not blank, copy the row to sheet 2 (row 1) - if it is blank, check the next row for data. - If the next row has data, copy that data after the last copied data in sheet 2 (row 2) - if it's blank, quit. - Keep checking for blank rows and copying into sheet two until it comes to two consecutive rows that are blank. What I need it to do is start in sheet 1 as it does now but instead of looking in column A for blank rows I need it to look in Columns AF & BL and if there is no data in either row I need it to check the next row and then copy if there any in there. Also being a pain if theres data in columns AF or BL I need the data in the rows in columns C,D,E to copy over too. Macro shown below. ' Macro2 Macro ' Macro recorded 07/07/2006 by Masters 'Option Explicit Sub test() Dim wks1 As Worksheet, wks2 As Worksheet Dim LastRow As Long, StartRow As Long, x As Long Dim rng1 As Range, rng2 As Range, FinishRow As Long Dim fn As WorksheetFunction Set fn = Application.WorksheetFunction Set wks1 = ThisWorkbook.Sheets("Sheet2") Set wks2 = ThisWorkbook.Sheets("Sheet4") wks2.Cells.ClearContents With wks1 On Error Resume Next StartRow = _ Application.InputBox(Prompt:="Select any cell in your beginning row", Type:=8).Row If Not IsNumeric(StartRow) Then Exit Sub Err.Clear On Error GoTo 0 LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row FinishRow = LastRow For x = StartRow To LastRow If fn.CountA(.Rows(x)) = 0 And fn.CountA(.Rows(x + 1)) = 0 Then FinishRow = fn.Max(StartRow, x - 1) Exit For End If Next x Set rng1 = .Range(.Cells(StartRow, 1), .Cells(FinishRow, 256)) rng1.Copy wks2.Range("A1") End With With wks2 LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row For x = LastRow To 1 Step -1 If fn.CountA(.Rows(x)) = 0 Then .Rows(x).Delete shift:=xlUp Next x End With End Sub Many many thanks to all the helpful crew on here -- tweacle |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Search, Copy, Paste Macro in Excel | Excel Worksheet Functions | |||
Closing File Error | Excel Discussion (Misc queries) | |||
macro with F9 | Excel Discussion (Misc queries) | |||
Make Alignment options under format cells available as shortcut | Excel Discussion (Misc queries) | |||
Playing a macro from another workbook | Excel Discussion (Misc queries) |