create list

[kasbac]

Hi there

I need held writing a macro that will start out by looking at each line in coulm C. If the line equals "xxx" coulm A and D in the same line should be copy/paste special values in to the worksheet "zzz" in coulmn A and B starting in line 2.

Hope someone will be able to give me a hand?

 

[VoG]

Try

Sub test()
Dim LR As Long, i As Long
LR = Range("C" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    If Range("C" & i).Value = "xxx" Then
        Range("A" & i).Copy
        Sheets("zzz").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        Range("D" & i).Copy
        Sheets("zzz").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
    End If
Next i
End Sub

 

[dave3009]

Perhaps

Sub Macro1()
Dim lst As Long
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Sheet1
Set sh2 = Sheets("zzz")
lst = sh1.Range("A" & Rows.Count).End(xlUp).Row
    sh1.Range("$A$2:$D$" & lst).AutoFilter Field:=3, Criteria1:="xxx"
    sh1.Range("$A$2:$A$" & lst).SpecialCells(xlCellTypeVisible).Copy
    sh2.Range("A2").PasteSpecial xlPasteValues
    sh1.Range("$D$2:$D$" & lst).SpecialCells(xlCellTypeVisible).Copy
    sh2.Range("B2").PasteSpecial xlPasteValues
    
End Sub

 

[kasbac]

Hi guys

Thanks for the replys!

What changes would I need to do in Peters macro so that the values are pasted in from line 3 an onwards in the "zzz" tab?

 

[VoG]

Try

Sub test()
Dim LR As Long, i As Long, LR2 As Long
LR = Range("C" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    If Range("C" & i).Value = "xxx" Then
        LR2 = WorksheetFunction.Min(3, Sheets("zzz").Range("A" & Rows.Count).End(xlUp).Row + 1)
        Range("A" & i).Copy
        Sheets("zzz").Range("A" & LR2).PasteSpecial Paste:=xlPasteValues
        Range("D" & i).Copy
        Sheets("zzz").Range("B" & LR2).PasteSpecial Paste:=xlPasteValues
    End If
Next i
End Sub

 

[kasbac]

hmm not sure excatly whats going on but the macro only seem to transfer the first and last line containing xxx to the zzz tab? these are pasted in from A2 and onwards?

 

[VoG]

Sorry, it should be

Sub test()
Dim LR As Long, i As Long, LR2 As Long
LR = Range("C" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    If Range("C" & i).Value = "xxx" Then
        LR2 = WorksheetFunction.Max(3, Sheets("zzz").Range("A" & Rows.Count).End(xlUp).Row + 1)
        Range("A" & i).Copy
        Sheets("zzz").Range("A" & LR2).PasteSpecial Paste:=xlPasteValues
        Range("D" & i).Copy
        Sheets("zzz").Range("B" & LR2).PasteSpecial Paste:=xlPasteValues
    End If
Next i
End Sub