Excel Macro to copy rows from one worksheet to another worksheet

[twildone]

I am new to macros and I am having problems with creating a macro that will copy an entire row from the original worksheet if column B is an LIR to a worksheet labelled LIR and to a worksheet labelled KLE if the row and column B in the original worksheet is KLE. I would like the macro to copy the entire row to the destination worksheet either worksheets LIR and KLE to start at the beginning of the worksheet at row 2 so that when the macro is ran it will updated the worksheets. Currently, when the macro is ran, it keeps adding the rows to the exisiting rows with data and keeps adding to it every time the macro is ran. I am including the the macro below.


Public Sub CopyRows()
LColumn = 1
Sheets("Data").Select
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column B
ThisValue = Cells(x, 2).Value
If ThisValue = "LIR" Then
Cells(x, 1).Resize(1, 33).Copy
'Copy to LIR Data1 worksheet
Sheets("LIR").Select
Sheets("LIR").Cells(2, LColumn).PasteSpecial
NextRow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Data").Select
ElseIf ThisValue = "KLE" Then
Cells(x, 1).Resize(1, 33).Copy
'Copy to KLE Data1 worksheet
Sheets("KLE").Select

Sheets("KLE").Cells(2, LColumn).PasteSpecial
NextRow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("Data").Select
End If
Next x

End Sub

 

[AlphaFrog]

On sheet "Data", this puts the word "Logged" in column 34 (AH) once those rows have been checked and copied to LIR or KLE. Those logged rows wont be copied again the next time you run the macro.

Sub CopyRows()

    Dim FirstRow As Long, LastRow As Long
    Dim ThisValue As String, x As Long
    
    With Sheets("Data")
    
        ' First row is the next empty row in column 34
        FirstRow = .Cells(Rows.Count, 34).End(xlUp).Row + 1
        ' Last row is the last used row in column 2
        LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
        
        ' Loop through each row
        For x = FirstRow To LastRow
            ' Decide if to copy based on column B
            ThisValue = .Cells(x, 2).Value
            If ThisValue = "LIR" Or ThisValue = "KLE" Then
                .Cells(x, "A").Resize(1, 33).Copy _
                    Destination:=Sheets(ThisValue).Cells(Rows.Count, "A").End(xlUp).Offset(1)
            End If
        Next x
        
        ' Put "Logged" in column 34
        .Range(.Cells(FirstRow, 34), .Cells(LastRow, 34)).Value = "Logged"
        
    End With
    
End Sub

 

[twildone]

Thanks for your help. I tried your code and what it did was first copied the very last row from the original worksheet that met the criteria of whether column B was a LIR or KLE to the very first row of their respective classification of LIR or KLE worksheets and it copied the appropriate rows twice (it ran throught the data set twice). Not to sure why it did this..

 

[twildone]

Hi...if I can get the macro to always copy the rows to the appropriate worksheets starting always at row 2 that would be great