Link to home
Start Free TrialLog in
Avatar of Justin
Justin

asked on

Vba code to append in Excel

Hi Guys, I got this code where I copy a series of rows and then append the rows. I remember Range("A1").End(XlDown).Offset(1,0)
but I cannot remember the rest of the code. Can someone help? here's the code:


Sub Macro24()

Dim i As target

i = Range("A1").End(xlDown).Offset(1, 0)

'
    Rows("1:1").Select
    Selection.AutoFilter
   
    ActiveSheet.Range("$A$1:$AE$389").AutoFilter Field:=11, Criteria1:=Array( _
        "Arbitrage", "BDF", "CD", "CORP NIM", "Derivatives", "NIM", "VBANK EPARGNE"), _
        Operator:=xlFilterValues
    Range("K1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
    Sheets("VBANK archive").Select

   
    Range("A925").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub
ASKER CERTIFIED SOLUTION
Avatar of Shums Faruk
Shums Faruk
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
How many columns you want to copy?
Sorry misread your code, below code will copy just column A to K:
Sub CopyFilteredRow()
Dim SrcWs As Worksheet, DestWs As Worksheet
Dim SrcLR As Long, DestLR As Long
Dim j As Long, i As Long
Dim Crit(6) As String
Dim StrIF As String
Dim RngFilter As Range, CopyRng As Range

With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

Application.DisplayAlerts = True
Set SrcWs = ActiveSheet
SrcLR = SrcWs.Range("A" & Rows.Count).End(xlUp).Row
Set DestWs = Worksheets("VBANK archive")
DestLR = DestWs.Range("A" & Rows.Count).End(xlUp).Row
Crit(0) = "Arbitrage"
Crit(1) = "BDF"
Crit(2) = "CD"
Crit(3) = "CORP NIM"
Crit(4) = "Derivatives"
Crit(5) = "NIM"
Crit(6) = "VBANK EPARGNE"

With SrcWs
    .AutoFilterMode = False
    .Range("AF").Value = "Temp"
    For j = 2 To SrcLR
        StrIF = "=if(or(isnumber(search(" & Chr(34) & Crit(0) & Chr(34) & ",K" & j & ")),isnumber(search(" & Chr(34) & Crit(1) & Chr(34) _
            & ",K" & j & ")),isnumber(search(" & Chr(34) & Crit(2) & Chr(34) & ",K" & j & ")),isnumber(search(" & Chr(34) & Crit(3) & Chr(34) & ",K" & j & "))),999,0)"
        .Range("AF" & j).Formula = StrIF
    Next j
End With

Set RngFilter = SrcWs.Range("A1:AF" & SrcLR)
Set CopyRng = SrcWs.Range("A2:K" & SrcLR)
RngFilter.AutoFilter Field:=32, Criteria1:="999", Operator:=xlFilterValues
CopyRng.SpecialCells(xlCellTypeVisible).Copy
DestWs.Range("A" & DestLR + 1).PasteSpecial xlPasteValues
SrcWs.Columns(32).Delete
Application.CutCopyMode = False
If SrcWs.AutoFilterMode = True Then SrcWs.AutoFilterMode = False
DestWs.Activate
DestWs.Columns(32).Delete
DestWs.Range("A2").Select
ActiveWindow.FreezePanes = True
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Open in new window

Avatar of Justin
Justin

ASKER

superb
You're Welcome! Glad I was able to help.