Hi,
I need further assistance on this matter.
After I create a database, how can I delete entire rows where cell in
column C (C2, C3,....) equals 0?
thank you in advance,
seba
On 28 jan., 15:33, ashish koul <koul.ash...@gmail.com> wrote:
> alright let us know if you require any help
>
> On Fri, Jan 28, 2011 at 2:51 PM, Seba <sebastjan.hri...@gmail.com> wrote:
> > Hi,
>
> > I made the following adjustment (marked with stars). It works fine. Do
> > you see any error in code or possible improvements? I will make an
> > addtional macro for: removing double entries + deleting rows with
> > value=0 + sorting
>
> > My modification:
>
> > ----------------------------------------------
> > Sub consolidatefromdifferentworkbooks()
>
> > Application.DisplayAlerts = False
> > 'On Error GoTo abc
> > Dim ask As Workbook
> > Dim ask2 As Workbook
> > Dim ASK3 As Workbook
> > Set ASK3 = ActiveWorkbook
> > Dim i As Long
> > Dim j As Long
> > Dim N, z, r, s, k As Long
> > s = 1
> > k = 1
> > Dim x As String
> > Dim temp As String
>
> > Sheets(1).Select
> > Range("A65356").Select
> > Selection.End(xlUp).Select
> > r = ActiveCell.Row
>
> > Workbooks.Open Filename:=ThisWorkbook.Sheets(1).Range("b2").Value
> > Set ask = ActiveWorkbook
> > For i = 2 To r
>
> > 'Workbooks(Range("a" & i).Value).Windows(1).Visible = False
>
> > ASK3.Activate
> > Sheets(1).Select
> > Workbooks.Open Filename:=Sheets(1).Range("a" & i).Value
> > Set ask2 = ActiveWorkbook
> > Sheets(1).Select
>
> > Range("A1").Select
>
> > ActiveCell.SpecialCells(xlLastCell).Select
>
> > N = ActiveCell.Row
> > If N >= 2 Then
>
> > Rows("1:" & N).Select
>
> > Selection.Copy
>
> > 'Sheets.Add After:=Sheets(Sheets.Count)
> > ask.Activate
> > ask.Sheets(1).Activate
> > Sheets(1).Select
> > Range("A1").Select
> > ActiveCell.SpecialCells(xlLastCell).Select
>
> > *****************************z = ActiveCell.Row +
> > 1*****************************************
>
> > Range("A" & z).Select
> > ***************************************Selection.PasteSpecial
> > Paste:=xlPasteValues**************************************
> > ActiveWorkbook.Save
> > ask2.Activate
> > ask2.Close
> > End If
>
> > Next i
>
> > 'abc:
> > 'Exit Sub
> > Application.DisplayAlerts = True
> > End Sub
> > ----------------------------------------------------------
>
> > regards
> > seba
>
> > On 27 jan., 17:31, ashish koul <koul.ash...@gmail.com> wrote:
> > > Sub consolidatefromdifferentworkbooks()
>
> > > Application.DisplayAlerts = False
> > > 'On Error GoTo abc
> > > Dim ask As Workbook
> > > Dim ask2 As Workbook
> > > Dim ASK3 As Workbook
> > > Set ASK3 = ActiveWorkbook
> > > Dim i As Long
> > > Dim j As Long
> > > Dim N, z, r, s, k As Long
> > > s = 1
> > > k = 1
> > > Dim x As String
> > > Dim temp As String
>
> > > Sheets(1).Select
> > > Range("A65356").Select
> > > Selection.End(xlUp).Select
> > > r = ActiveCell.Row
>
> > > Workbooks.Open Filename:=ThisWorkbook.Sheets(1).Range("b2").Value
> > > Set ask = ActiveWorkbook
> > > For i = 2 To r
>
> > > 'Workbooks(Range("a" & i).Value).Windows(1).Visible = False
>
> > > ASK3.Activate
> > > Sheets(1).Select
> > > Workbooks.Open Filename:=Sheets(1).Range("a" & i).Value
> > > Set ask2 = ActiveWorkbook
> > > * 'chnage sheet name here*
> > > *Sheets("PRIPRAVA_PROJEKTA").Select
> > > *
> > > Range("A1").Select
>
> > > ActiveCell.SpecialCells(xlLastCell).Select
>
> > > N = ActiveCell.Row
> > > If N >= 2 Then
>
> > > Rows("1:" & N).Select
>
> > > Selection.Copy
>
> > > 'Sheets.Add After:=Sheets(Sheets.Count)
> > > ask.Activate
> > > ask.Sheets(1).Activate
> > > Sheets(1).Select
> > > Range("A1").Select
> > > ActiveCell.SpecialCells(xlLastCell).Select
>
> > > z = ActiveCell.Row + 2
>
> > > Range("A" & z).Select
> > > ActiveSheet.Paste
> > > ActiveWorkbook.Save
> > > ask2.Activate
> > > ask2.Close
> > > End If
>
> > > Next i
>
> > > 'abc:
> > > 'Exit Sub
> > > Application.DisplayAlerts = True
> > > End Sub
>
> > > On Thu, Jan 27, 2011 at 9:57 PM, ashish koul <koul.ash...@gmail.com>
> > wrote:
>
> > > > put sheetnames always in double quotes Sheets("PRIPRAVA_PROJEKTA").
>
> > > > On Thu, Jan 27, 2011 at 9:23 PM, Seba <sebastjan.hri...@gmail.com>
> > wrote:
>
> > > >> Hi,
>
> > > >> I made the following change for sheet name and I get the error
> > > >> "Subscript out of range". Sheets(1) -> Sheets(PRIPRAVA_PROJEKTA)
>
> > > >> Sub consolidatefromdifferentworkbooks()
> > > >> Application.DisplayAlerts = False
> > > >> 'On Error GoTo abc
> > > >> Dim ask As Workbook
> > > >> Dim ask2 As Workbook
> > > >> Dim ASK3 As Workbook
> > > >> Set ASK3 = ActiveWorkbook
> > > >> Dim i As Long
> > > >> Dim j As Long
> > > >> Dim N, z, r, s, k As Long
> > > >> s = 1
> > > >> k = 1
> > > >> Dim x As String
> > > >> Dim temp As String
>
> > > >> Sheets(1).Select
> > > >> Range("A65356").Select
> > > >> Selection.End(xlUp).Select
> > > >> r = ActiveCell.Row
>
> > > >> Workbooks.Open Filename:=ThisWorkbook.Sheets(1).Range("b2").Value
> > > >> Set ask = ActiveWorkbook
> > > >> For i = 2 To r
>
> > > >> 'Workbooks(Range("a" & i).Value).Windows(1).Visible = False
> > > >> ASK3.Activate
> > > >> Sheets(PRIPRAVA_PROJEKTA).Select
> > > >> Workbooks.Open Filename:=Sheets(PRIPRAVA_PROJEKTA).Range("a" &
> > > >> i).Value
> > > >> Set ask2 = ActiveWorkbook
> > > >> Sheets(PRIPRAVA_PROJEKTA).Select
>
> > > >> Range("A1").Select
> > > >> ActiveCell.SpecialCells(xlLastCell).Select
>
> > > >> N = ActiveCell.Row
> > > >> If N >= 2 Then
> > > >> Rows("1:" & N).Select
>
> > > >> Selection.Copy
>
> > > >> 'Sheets.Add After:=Sheets(Sheets.Count)
> > > >> ask.Activate
> > > >> ask.Sheets(1).Activate
> > > >> Sheets(1).Select
> > > >> Range("A1").Select
> > > >> ActiveCell.SpecialCells(xlLastCell).Select
>
> > > >> z = ActiveCell.Row + 1
>
> > > >> Range("A" & z).Select
> > > >> ActiveSheet.Paste
> > > >> ActiveWorkbook.Save
> > > >> ask2.Activate
> > > >> ask2.Close
> > > >> End If
>
> > > >> Next i
> > > >> 'abc:
> > > >> 'Exit Sub
> > > >> Application.DisplayAlerts = True
> > > >> End Sub
>
> > > >> -------------------------
> > > >> regards
> > > >> seba
>
> > > >> On 27 jan., 16:44, ashish koul <koul.ash...@gmail.com> wrote:
> > > >> > shannur can you attch the sample workbook
>
> > > >> > On Thu, Jan 27, 2011 at 9:13 PM, ashish koul <koul.ash...@gmail.com
>
> > > >> wrote:
>
> > > >> > > use 2 for second sheet or 3 for 3 rd sheet like
> > > >> > > sheets(2).select or you can also sheets("abc").select
>
> > > >> > > Workbooks.Open Filename:=Sheets(1).Range("a" & i).Value
> > > >> > > Set ask2 = ActiveWorkbook
> > > >> > > Sheets(1).Select
>
> > > >> > > @shannur can you send a sample workbook
>
> > > >> > > On Thu, Jan 27, 2011 at 9:04 PM, shannu shannu <
> > shannur...@yahoo.com
> > > >> >wrote:
>
> > > >> > >> Hi Ashish,
>
> > > >> > >> Life and death matter, I have a workbook and again it has diff
> > sheets
> > > >> like
> > > >> > >> sheet 1 to sheet 11. and now my task is to copy unique names from
> > > >> sheet 1
> > > >> > >> search in other sheets if it is existing then I need to copy only
> > > >> those row
> > > >> > >> from the diff sheets and create a fresh new workbook and name the
> > > >> workbook
> > > >> > >> with that name of the person
>
> > > >> > >> Regards,
> > > >> > >> Shannur
>
> > > >> > >> --- On *Thu, 1/27/11, ashish koul <koul.ash...@gmail.com>*
> > wrote:
>
> > > >> > >> From: ashish koul <koul.ash...@gmail.com>
>
> > > >> > >> Subject: Re: $$Excel-Macros$$ build a database from multiple
> > > >> workbooks
> > > >> > >> To: excel-macros@googlegroups.com
> > > >> > >> Date: Thursday, January 27, 2011, 2:10 PM
>
> > > >> > >> On Thu, Jan 27, 2011 at 11:37 AM, ashish koul <
> > > >> koul.ash...@gmail.com<
> > > >> http://us.mc1200.mail.yahoo.com/mc/compose?to=koul.ash...@gmail.com>
> > > >> > >> > wrote:
>
> > > >> > >> Sub consolidatefromdifferentworkbooks()
> > > >> > >> Application.DisplayAlerts = False
> > > >> > >> 'On Error GoTo abc
> > > >> > >> Dim ask As Workbook
> > > >> > >> Dim ask2 As Workbook
> > > >> > >> Dim ASK3 As Workbook
> > > >> > >> Set ASK3 = ActiveWorkbook
> > > >> > >> Dim i As Long
> > > >> > >> Dim j As Long
> > > >> > >> Dim N, z, r, s, k, d As Long
> > > >> > >> s = 1
> > > >> > >> k = 1
> > > >> > >> Dim x As String
> > > >> > >> Dim temp As String
> > > >> > >> Dim sht As Worksheet
>
> > > >> > >> Set ask2 = ActiveWorkbook
> > > >> > >> Sheets(1).Select
> > > >> > >> Range("A65356").Select
> > > >> > >> Selection.End(xlUp).Select
> > > >> > >> r = ActiveCell.Row
>
> > > >> > >> Workbooks.Open
> > Filename:=ThisWorkbook.Sheets(1).Range("b2").Value
> > > >> > >> Set ask = ActiveWorkbook
>
> > > >> > >> For i = 2 To r
> > > >> > >> 'Workbooks(Range("a" & i).Value).Windows(1).Visible = False
> > > >> > >> ASK3.Activate
> > > >> > >> Sheets(1).Select
> > > >> > >> Workbooks.Open Filename:=Sheets(1).Range("a" & i).Value
> > > >> > >> Set ask2 = ActiveWorkbook
>
> > > >> > >> For d = 1 To ask2.Sheets.Count
> > > >> > >> Sheets(d).Activate
> > > >> > >> Sheets(d).Select
> > > >> > >> Range("A1").Select
> > > >> > >> ActiveCell.SpecialCells(xlLastCell).Select
>
> > > >> > >> ' Selection.End(xlToRight).Select
> > > >> > >> '
> > > >> > >> '
> > > >> > >> 'temp = ActiveCell.Address
> > > >> > >> 'x = Mid(temp, 2, (InStr(2, temp, "$") - 2))
> > > >> > >> '
> > > >> > >> '
> > > >> > >> '
> > > >> > >> ' Range("A65356").Select
> > > >> > >> ' Selection.End(xlUp).Select
> > > >> > >> N = ActiveCell.Row
> > > >> > >> If N >= 2 Then
> > > >> > >> Rows("1:" & N).Select
>
> > > >> > >> Selection.Copy
>
> > > >> > >> 'Sheets.Add After:=Sheets(Sheets.Count)
> > > >> > >> ask.Activate
> > > >> > >> ask.Sheets(1).Activate
> > > >> > >> Sheets(1).Select
> > > >> > >> Range("A1").Select
> > > >> > >> ActiveCell.SpecialCells(xlLastCell).Select
>
> > > >> > >> z = ActiveCell.Row + 2
>
> > > >> > >> Range("A" & z).Select
> > > >> > >> ActiveSheet.Paste
> > > >> > >> ActiveWorkbook.Save
> > > >> > >> ask2.Activate
> > > >> > >> End If
> > > >> > >> Next d
> > > >> > >> ask2.Activate
> > > >> > >> ask2.Close
>
> > > >> > >> ask.Activate
> > > >> > >> ask.Sheets(1).Activate
>
> > > >> > >> ActiveWorkbook.Save
> > > >> > >> Next i
> > > >> > >> 'abc:
> > > >> > >> 'Exit Sub
> > > >> > >> Application.DisplayAlerts = True
> > > >> > >> End Sub
>
> > > >> > >> On Thu, Jan 27, 2011 at 11:23 AM, Squall <
> > squall.l...@gmail.com<
> > > >> http://us.mc1200.mail.yahoo.com/mc/compose?to=squall.l...@gmail.com>
> > > >> > >> > wrote:
>
> > > >> > >> Hi guys,
>
> > > >> > >> Could you please share us the coding especially when helping...
> > it
>
> ...
>
> preberite več »
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
