AutoFilter-Copy Paste-Save sheet-Delete info
Hi All,
It would be greate if some one help me on this,
I have created a macro for the following,
1- It selects the data from "Data" sheet
2-Copy and past it in "ADL" sheet
3-We have Main sheet, which has few Macro buttons to execute above 1 & 2 Action.
However, i have problem here, every time i need to select the data for a specific number and paste it in "Data" sheet and after that i am executing the Macro for the actions above (1&2). After executing the marcos i need to delete the data pasted in ADL and again select the data for a specfic number and paste it in "Data" Sheet. like this i create around 50 sheets.
For Example:
ACCOUNT CENTER Market
110000010 605186 123
110000010 605186 123
110020000 605186 123
110020000 605186 123
509999999 605186 123
509999999 605186 123
509999999 605186 123
555555511 605186 123
555555511 605186 123
Every time i need to filter on account, select data for one account and paste in Macro Sheet"Data" and execute the Macros and saved in specified location.
Soultion Needed: Is there any macro for below actions
A- I Create another sheet called "Raw"
B- macro will set fileter, select one Account and copy and paste it in "Data"
C-Macros in Main sheet execute further action and save the file in sepcified location
D-Delete the data in ADL file
and again macro fun A/B/C and D until it completes all accounts.
Regards,
Sri
Macro i have created:
Private Sub CommandButton1_Click()
BENONI = Date
Sheets("Fiscal Calender").Activate
A = Sheets("Fiscal Calender").Range("W6")
AA = Sheets("Fiscal Calender").Range("X6")
B = Sheets("Fiscal Calender").Range("W7")
BB = Sheets("Fiscal Calender").Range("X7")
C = Sheets("Fiscal Calender").Range("W8")
CC = Sheets("Fiscal Calender").Range("X8")
E = Sheets("Fiscal Calender").Range("W9")
EE = Sheets("Fiscal Calender").Range("X9")
D = InputBox("Closing Dates are Below" _
& vbCr & A & " " & AA _
& vbCr & B & " " & BB _
& vbCr & C & " " & CC _
& vbCr & E & " " & EE, "DATE OF JE PREPARED", [BENONI])
Sheets("ADI").Activate
Sheets("ADI").Range("J11").Select
ActiveCell.Value = D
'DATE ENTERED AND SECOND MACRO RUNS
Sheets("Data").Activate
Sheets("data").Range("A2").Select
Selection.Copy
Sheets("ADI").Activate
Sheets("ADI").Range("J10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Data").Activate
Sheets("data").Range("B2").Select
Selection.Copy
Sheets("ADI").Activate
Sheets("ADI").Range("J12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("ADI").Range("J13").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("ADI").Range("J14").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("ADI").Range("J15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Data").Activate
Sheets("data").Range("F2").Select
Selection.Copy
Sheets("ADI").Activate
Sheets("ADI").Range("J16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'NEXT
Sheets("Data").Activate
Sheets("data").Range("G2:R2").Select
Sheets("data").Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("ADI").Activate
Sheets("ADI").Range("C21").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'next
Sheets("Data").Activate
Sheets("data").Range("s2").Select
Sheets("data").Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("ADI").Activate
Sheets("ADI").Range("t21").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'next
Sheets("Data").Activate
Sheets("data").Range("t2").Select
Sheets("data").Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("ADI").Activate
Sheets("ADI").Range("u21").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'next
Sheets("Data").Activate
Sheets("data").Range("u2").Select
Sheets("data").Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("ADI").Activate
Sheets("ADI").Range("ab21").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Private Sub CommandButton2_Click()
Sheets("data").Activate
RowCount = Application.WorksheetFunction.CountA(Sheets("data").Range("a:a"))
MsgBox (RowCount - 1)
Sheets("ADI").Activate
Sheets("ADI").Range("C22").Select
RowCount = Application.WorksheetFunction.CountA(Sheets("data").Range("A:A"))
Sheets("ADI").Range("C22").Resize(RowCount, 1).EntireRow.Insert
MsgBox (RowCount - 1 & " " & " " & ("Rows Are Inserted in ADI Sheet"))
Sheets("MAIN").Activate
End Sub
Private Sub CommandButton3_Click() 'MACRO TO SAVE THE FILE IN THE LOCATION
Dim wb As Workbook
MSG2 = MsgBox("Are You Sure You Want to SAVE the ADI Sheet ", vbYesNo, "To Save: YES Else NO")
If MSG2 = vbYes Then
spath = Sheets("MAIN").Range("K14")
rn = Sheets("adi").Range("J13")
A = InputBox("Specify the Month Here to add to File Name")
Worksheets("Adi").Copy
Set wb = ActiveWorkbook
wb.SaveAs Filename:=(spath & rn & " " & "-" & A & ".xls")
MsgBox (" File saved in" _
& vbCr & " " & spath)
Else
MsgBox "File Not Saved"
End If
End Sub
Private Sub CommandButton4_Click() 'MACRO TO DELETE ROWS
Dim FR As Long, LR As Long
MSG1 = MsgBox("Are You Sure You Want to Delete the Rows ", vbYesNo, "To Delete: YES Else NO")
If MSG1 = vbYes Then
Sheets("ADI").Activate
With Sheets("ADI")
FR = 21
LR = .Range("C" & Rows.Count).End(xlUp).Row
.Rows(FR & ":" & LR).Delete
End With
MsgBox ("Rows Deleted")
Else
MsgBox "You Have Cancelled The Action"
End If
Sheets("MAIN").Activate
End Sub
Private Sub CommandButton5_Click()
Sheets("DATA").Activate
ActiveSheet.Range("a:xfd").Select
Selection.Delete Shift:=xlUp
Sheets("DATA").Range("A1").Select
Sheets("MAIN").Activate
End Sub
Private Sub CommandButton6_Click()
Sheets("ADI").Select
ActiveSheet.Range("U20:u1048576").Select
Selection.Replace What:=".", Replacement:="\.", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
MsgBox ("Project Numbers having . replaced with \.")
Sheets("main").Activate
End Sub
Attachment | Size |
---|---|
MY MACRO.xlsm | 313.74 KB |
Could you provide the sample
Could you provide the sample file please.
Hi , Could you please provide
Hi ,
Could you please provide the solution for this. Its pretty urgent
hi Srikanth Forum questions
hi Srikanth
Forum questions answered for free are on a best efforts basis
For a quick response: Request a Quote
tks
Nick
Sample File Provided
Hi Vishesh,
I have attached the Same file. Let me know if you need any other information.
Thanks for the help.
Regards,
Sriaknth
The Macro has to set the
The Macro has to set the filter in Raw data, copy data for each order number in Raw and past it in Data and i have to run the Macros in Main (1 , 2 , 3, 4 , A and to delete)