Copy multiple columns to another worksheet



I have XML feed which has lot of unnecessary data, so I found following macro to copy rows, which include "Soccer" in column BA, to new worksheet What I'd like it to do is to copy only specifics columns E,I,P,T,W,Y,Z to sheet not whole rows, so then I don't have to hide those unnecessary columns.


Sub SearchForString()



Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 3
LSearchRow = 3

'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

'If value in column BA = "Soccer", copy entire row to Sheet2
If Range("BA" & CStr(LSearchRow)).Value = "Soccer" Then

'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into Sheet2 in next row
Sheets("Sheet2").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select

End If

LSearchRow = LSearchRow + 1

Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub

No comments:

Post a Comment