marreco
Well-known Member
- Joined
- Jan 1, 2011
- Messages
- 609
- Office Version
- 2010
- Platform
- Windows
I need copy data to another sheet
My tab("Relatorio") hava CFOP in column M, if find any value start 1 or 2 like this(
<tbody>
</tbody>Copy to tab("Saida") case start like this(
<colgroup><col width="64" span="3"></colgroup><tbody>
</tbody>)
Copy to tab("Entrada")
<colgroup><col style="width:48pt" width="64" span="2"> </colgroup><tbody>
</tbody>This is the code:
My tab("Relatorio") hava CFOP in column M, if find any value start 1 or 2 like this(
1253/AA | 1949/ZZ | 2102/AA | 2353/AA | 2920/AA) |
<tbody>
</tbody>
5921/AA | 6152/AA | 6202/AA |
<colgroup><col width="64" span="3"></colgroup><tbody>
</tbody>
Copy to tab("Entrada")
CFOP | Go to tab |
1253/AA | Entrada |
1949/ZZ | Entrada |
2102/AA | Entrada |
2353/AA | Entrada |
2920/AA | Entrada |
5921/AA | Saida |
6152/AA | Saida |
6202/AA | Saida |
<colgroup><col style="width:48pt" width="64" span="2"> </colgroup><tbody>
</tbody>
Code:
Sub Copy_sht1_To_sht2()
'This code made by Fluff, I try adapt
Dim ws As Worksheet
Dim UsdRws As Long
Dim Fltr As Variant
Dim Val As Variant
Dim Cl As Range
Dim Dict As Object
Set ws = Sheets("Relatorio")
UsdRws = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set Dict = CreateObject("scripting.dictionary")
Fltr = Array("5*", "6*") 'Array("5921/AA", "6152/AA", "6202/AA")
With ws
For Each Val In Fltr
For Each Cl In .Range("M2:M" & UsdRws)
If Cl.Value Like Val Then Dict(Cl.Value) = vbNullString
Next Cl
Next Val
.Range("A1:AS" & UsdRws).AutoFilter Field:=13, Criteria1:=Dict.Keys, Operator:=xlFilterValues
.AutoFilter.Range.Offset(1).Copy Sheets("Saida").Range("A" & Rows.Count).End(xlUp).Offset(1)
'If Cl.Value = Fltr Then
' .Range("A1:AS" & UsdRws).AutoFilter Field:=13, Criteria1:=Dict.Keys, Operator:=xlFilterValues
' .AutoFilter.Range.Offset(1).Copy Sheets("Saida").Range("A" & Rows.Count).End(xlUp).Offset(1)
'Else
' .Range("A1:AS" & UsdRws).AutoFilter Field:=13, Criteria1:=Dict.Keys, Operator:=xlFilterValues
' .AutoFilter.Range.Offset(1).Copy Sheets("Entrada").Range("A" & Rows.Count).End(xlUp).Offset(1)
'End If
End With
ws.AutoFilterMode = False
Set ws = Nothing
Set Dict = Nothing
End Sub