Macro to copy rows with data from one sheet to another...

[LittleAngel]

I have 2 worksheets. I'd like to have a macro (I am new to macros) that does the following:

- 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.

Thank you!

 

[Jay Petrulis]

Hi,

The following worked for me. Please try this and report your results.

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("Sheet1")
Set wks2 = ThisWorkbook.Sheets("Sheet2")

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

 

[LittleAngel]

Thank you very much! That worked PERFECTLY!

How do I make a button in the toolbar to run that macro?

 

[blindbe2]

What if instead of the row being "not blank" that a cell in the row met certain criteria like "Starts with a 1"?

Could I just alter the above macro to pull from sheet 1 an entire row where column b "starts with an L" or "an M" and paste those rows in sheet 2?

Thanks.

 

[blindbe2]

For instance if column B starts with an L could I set it up to automatically pull those entire rows into a summary sheet in order separate jobs by salesperson and tally totals.

job cost template2.xls
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
4	Name	Job Number	Job Type	Total Contract	RbA Cost	%	Material Cost	%	Labor Cost	%	Outside	%	Production Overhead	Gross Profit	%
5	McKinley	L56553	Win	19,972	7,276	36	1,794	9	650	3		0	240	10,012	50
6	Jacobs	L56874	Win	2,635	677	26	581	22		0	110	4	60	1,207	46
7	Mayer	M52234	Door	881		0	148	17	336	38		0	30	367	42
8	Mayer	M52234	Siding	27,100		0	6,850	25	12,350	46	5,420	20	0	2,480	9
9	Conley	M53514	Door	2,440		0	264	11	1,530	63		0	30	616	25
10	Lokken	M58742	Carp	53,500		0	25,200	47	16,400	31	2,430	5	0	9,470	18
11	Doran	S50912	Roof	11,200		0	2,220	20	3,540	32		0		5,440	49
12	Kuntz	S51015	Win	12,665	3,250	26	457	4		0		0	220	8,738	69
List

 

[Vba_idiot]

sorry i have a few questions regarding the code..

how do i:

- edit the StartRow to hardcode it to the Row & Column pre-defined
- edit it to allow me to choose which cell to check
- edit it to allow me to choose which cell to copy

pls help me..!

 

[Tanis]

I need to do something similar, so I used the code as written. Unfortunately, I get the error message "Subscript out of range" on this line.

Set wks2 = ThisWorkbook.Sheets("Sheet2")

I copied and pasted into a new module and ran it from there, so there are no typos

Can anyone shed any light on the problem?

David

 

[Jay Petrulis]

I need to do something similar, so I used the code as written. Unfortunately, I get the error message "Subscript out of range" on this line.

Set wks2 = ThisWorkbook.Sheets("Sheet2")

I copied and pasted into a new module and ran it from there, so there are no typos

Can anyone shed any light on the problem?

David

The workbook that contains the code must have a sheet named "Sheet2" or else the code will throw the error you received.

 

[pink]

Hi,

Is it possible to do the same thing, except rather than retrieving any row that contains data, retrieving only those rows where column A contains a date between 1996 and 1998? And then, rather than retrieving the entire row, only retrieving the data from columns A and H?

Thanks.

 

[agihcam]

how was your date in column inputted? is it in date format or plane 1996,1997, etc? are you going to retrieve only those dates and corresponding row data? for example, you want to retrieve date between 1996 and 1998, the sheets2 will show only these dates and row data?