Copy and Paste error.

[matriding29]

Hello,

I'm new to using macros and VBA, in my role I receive xml documents containing data on a daily basis, I open this data up through excel (2010) as it is easier to read. From this data I filter the information to leave myself with what is relevant to my section. Each xml document I receive is a different size however I am only concentrating on one column.

My plan is to save a macro into a separate workbook so that when I open up my xml document, I can run this macro to filter out everything I don't need and copy the relevant rows across into a new sheet.

I've tried to record a macro however I am being faced with a Run-time error '1004':
The information cannot be pasted because the Copy area and the paste area are not the same size and shape. Try one of the following:

• Click a single cell, and then paste.
• Select a rectangle that's the same size and shape, and then paste.

The macro I have recorded is trying to select column I, filter for contains "=*1bb15*", if it contains this info, select the rows, open sheet 2 ,copy into it, return to sheet 1, clear filter, filter for contains =*043A*, if it contains this info, select the rows, open sheet 2, copy into next free row, return to sheet 1, clear filter.

I will want this to eventually loop round and carry out more wildcard filters.

This is what I have so far which is giving me the above eror:

Sub Macro1()
'
' Macro1 Macro
'


'
Columns("I:I").Select
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=9, Criteria1:= _
"=*1bb15*", Operator:=xlAnd
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=9
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=9, Criteria1:= _
"=*043A*", Operator:=xlAnd
Cells.Select
Application.CutCopyMode = False
Selection.Copy
With Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
End With
End Sub
Sorry for the long post, just trying to paint the entire picture. Any help would be greatly appreciated as I am well and truly stuck!

Thanks!

 

[matriding29]

Sub Macro1()
'
' Macro1 Macro
'


'
Columns("I:I").Select
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=9, Criteria1:= _
"=*1bb15*", Operator:=xlAnd
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=9
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=9, Criteria1:= _
"=*043A*", Operator:=xlAnd
Cells.Select
Application.CutCopyMode = False
Selection.Copy
With Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
End With
End Sub

Marked red is what is highlighted when I click debug.