Excel Macro to copy rows from one worksheet to another worksheet

T

twildone

Board Regular
Joined
Jun 3, 2011
Messages
68
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
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Sort by date Sort by votes
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.

Code: 
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
 
Upvote 0
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..
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
VBA copy a few fields only from 1 sheet to another
Replies
7
Views
324
dcavaiani
D
N
  • Question
My code is suddenly really slow
Replies
1
Views
134
RobP
R
F
  • Question
How to Transfer a row to another sheet based on a value in a cell
Replies
2
Views
443
Flavien
F
tabbytomo
  • Solved
Copy entire row if cell has specific value, looking at multiple columns and worksheets.
Replies
2
Views
290
NateSC
NateSC
J
  • Solved
Code to copy over row if certain criteria is met
2
Replies
18
Views
581
mumps
mumps

Forum statistics

Threads
1,214,978
Messages
6,122,549
Members
449,089
Latest member
davidcom

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top