Macro to create seperate lists

T

Tony

I have been trying to piece together what I'm after but don't seem to be able
to do it.

I have a sheet named "Monthly". What I would like to do is loop through the
rows in "Monthly" find where the date value in column K matches the value
typed into cell A1, copy that row and paste into another sheet in the
workbook (already created) called "Sub Lists", starting the pasting from cell
G4.

If it weren't getting too difficult, is it possible instead of copying the
entire row that matches the criteria in column K to only copy certain cells
in that row. For example, if K6 had a date value that match the date typed
into cell A1, instead of copying the entire row 6, only the values in
A6,C6,D6,G6,K6,I6 would be copied and pasted into the other sheet (still
starting in cell G4).

I hope I explained that ok, any help would be much appreciated.

Thanks
 
P

Per Jessen

Hi

Try this:

Sub copy()
Dim TargetRange As String
Dim CopyRow As Range

Application.ScreenUpdating = False
TargetRange = "A1:Q1000"

Worksheets("Monthly").Activate
Range(TargetRange).Select
Selection.AutoFilter FIeld:=11, Criteria1:=Range("A1").Value

Set HelpSH = Worksheets.Add
Worksheets("Monthly").Activate
Selection.copy HelpSH.Range("A1")
HelpSH.Activate
Range("K2", Range("k2").End(xlDown)).Select

For Each r In Selection.Rows
Set CopyRow = Application.Union(Cells(r.Row, 1), Cells(r.Row, 3), _
Cells(r.Row, 4), Cells(r.Row, 4), Cells(r.Row, 7), _
Cells(r.Row, 11), Cells(r.Row, 9))
CopyRow.copy Destination:=Worksheets("Sub Lists").Cells(4 + off, "G")
off = off + 1
Next
With Application
.CutCopyMode = False
Selection.AutoFilter
.DisplayAlerts = False
HelpSH.Delete
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

Best regards,
Per
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top