Vba code to append in Excel

Justin
Justin used Ask the Experts™
on
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
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
View Solution Only
Managing Director/Excel VBA Developer
Distinguished Expert 2018
Commented:
Hi,

Try another approach:
Sub CopyFilteredRow()
Dim SrcWs As Worksheet
Dim SrcLR As Long
Dim j As Long, i As Long
Dim Crit(6) As String
Dim StrIF As String
Dim RngFilter 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
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)
With RngFilter
    .AutoFilter Field:=32, Criteria1:="999", Operator:=xlFilterValues
    .SpecialCells(xlCellTypeVisible).Copy
    SrcWs.Range("A925").PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
If SrcWs.AutoFilterMode = True Then SrcWs.AutoFilterMode = False
SrcWs.Columns(32).Delete
SrcWs.Range("A925").Select
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Open in new window

ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018

Commented:
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

JustinFinancial Control

Author

Commented:
superb
ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018

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

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial