How do I copy to another worksheet specific columns and rows - excel

Question

I have a worksheet with columns A:M and rows 1 to 5000. I would like to copy rows to another worksheet when a number greater then 0 is added to column L and M. I also only require columns A:F and K:M on the new worksheet

Answer 1

you'll need to name the source and target worksheets, but below code should do the trick.
Sub SheetTransfer()
Dim i As Long
Dim j As Long
Dim t As Double
Dim LastRow As Long
Dim ws1 As String
Dim ws2 As String
'name source worksheet here
ws1 = "Sheet1"
'name target worksheet here
ws2 = "Sheet2"
'set the threshold value for a row to be copied over
t = 0
' set to column L
j = 12
For i = 1 To 5000
If Worksheets(ws1).Cells(i, j).Value > 0 Or Cells(i, j + 1).Value > t Then
'find last row of target worksheet
With Worksheets(ws2)
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'copy/paste columns A-F
Worksheets(ws1).Range(Cells(i, 1), Cells(i, 6)).Copy
Worksheets(ws2).Cells(LastRow + 1, 1).PasteSpecial xlPasteValues
'copy paste columns K-M
Worksheets(ws1).Range(Cells(i, 11), Cells(i, 13)).Copy
Worksheets(ws2).Cells(LastRow + 1, 11).PasteSpecial xlPasteValues
End If
Next i
End Sub

Answer 2

Copy Data to Other Worksheet
Adjust the values in the constants section to fit your needs.
The Code
Sub AM5000()
' Source
Const cVntSource As Variant = "Sheet1" ' Source Worksheet Name/Index
Const cStrRange1 As String = "A1:F5000" ' Source 1 Range Address
Const cStrRange2 As String = "K1:M5000" ' Source 2 Range Address
Const cIntCol1 As Integer = 2 ' Source Range Criteria Column 1
Const cIntCol2 As Integer = 3 ' Source Range Criteria Column 2
' Target
Const cVntTarget As Variant = "Sheet2" ' Target Worksheet Name/Index
Const cStrTarget As String = "A1" ' Target First Cell Address
Dim vnt1 As Variant ' Source 1 Array
Dim vnt2 As Variant ' Source 2 Array
Dim vntTarget As Variant ' Target Array
Dim i As Integer ' Source Arrays Row Counter
Dim j As Integer ' Arrays Column Counter
Dim k As Integer ' Target Array Row Counter
' Paste Source Ranges into Source Arrays.
With Worksheets(cVntSource)
vnt1 = .Range(cStrRange1)
vnt2 = .Range(cStrRange2)
End With
' Count the number of rows for Target Array.
For i = 1 To UBound(vnt2)
If vnt2(i, cIntCol1) > 0 And vnt2(i, cIntCol2) > 0 Then
k = k + 1
End If
Next
' Write Source Arrays to Target Array.
ReDim vntTarget(1 To k, 1 To UBound(vnt1, 2) + UBound(vnt2, 2))
k = 0
For i = 1 To UBound(vnt2)
If vnt2(i, cIntCol1) > 0 And vnt2(i, cIntCol2) > 0 Then
k = k + 1
For j = 1 To UBound(vnt1, 2)
vntTarget(k, j) = vnt1(i, j)
Next
For j = 1 To UBound(vnt2, 2)
vntTarget(k, j + UBound(vnt1, 2)) = vnt2(i, j)
Next
End If
Next
' Paste Target Array into Target Range.
With Worksheets(cVntTarget).Range(cStrTarget)
'.Parent.Cells.ClearContents
.Resize(UBound(vntTarget), UBound(vntTarget, 2)) = vntTarget
End With
End Sub