PDA

View Full Version : VBA Coding help to cut rows & paste to "archive" tab



laubirch
09-15-2015, 02:49 PM
Hi

New to VBA and trying to self teach, totally confused though and would really like to be able to process the below unstead of manually copying & pasting the data.

I'm working on a file which i would like to auto archive lines that occur in the past (this will be calculated from a formula) Id like these to be Cut from the original tab and pasted to the bottom of an "archive" tab, so the archive tab will contain everything historical and the original tab remains just for lines in the future.

An extract of my file as below, this tab is Sheet 1 and named "OB Detail" Columns are A to R with a constantly updated number of Rows, id like anything where column R = Past to archive (cut) and paste into the "archive" tab which will contain exactly the same columns




A
B
C
D
E
F
G
H
I
J
K
L
M
N
O
P
Q
R


1
Day
Date
OB
Order #
EXEC
PR
T O
L C 1
L C 2
L C 3
PR £
T O £
LC 1 £
LC2 £
LC3 £
TOTAL
MONTH
Past


2
Sat
15-Aug
School
132635
AN
ST
AW
JP



50
39


89
Aug
Yes


3
Sat
19-Sep
Event
?
AR
EW
OC
JP


10
50
39


99
Sep
No


4
Sat
26-Sep
Business
134519
SJ
EW
?
?


10




10
Sep
No


5
Thu
01-Oct
School
134463
RW
ST
?
JP




39


39
Oct
No




Thank You in advance

Laura :)

jolivanes
09-15-2015, 07:17 PM
Try this on a copy of your workbook



Sub Laura()
With ActiveSheet
.AutoFilterMode = False
With Range("R1", Range("R" & Rows.Count).End(xlUp))
.AutoFilter 1, "*Yes*"
Range("A2:R" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(12).Copy Sheets("Archived").Cells(Rows.Count, Range("A1").Column).End(xlUp).Offset(1)
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
End With
.AutoFilterMode = False
End With
End Sub

laubirch
09-16-2015, 10:06 AM
Hi

Thank you so much, works a treat!!

Laura :)



Try this on a copy of your workbook



Sub Laura()
With ActiveSheet
.AutoFilterMode = False
With Range("R1", Range("R" & Rows.Count).End(xlUp))
.AutoFilter 1, "*Yes*"
Range("A2:R" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(12).Copy Sheets("Archived").Cells(Rows.Count, Range("A1").Column).End(xlUp).Offset(1)
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
End With
.AutoFilterMode = False
End With
End Sub