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
> > >> really
> > >> > >> help to improve those being helped (especially me) to understand
> the
> > >> vba
> > >> > >> macro/coding. Sometimes when I try to open the module/code, it's
> > >> protected
> > >> > >> by password :(
> >
> > >> > >> Nonetheless, thanks for the help.
> >
> > >> > >> On 1/26/2011 10:33 PM, ashish koul wrote:
> >
> > >> > >> try this macro see if it helps
> >
> > >> > >> On Wed, Jan 26, 2011 at 4:22 PM, Seba <
> sebastjan.hri...@gmail.com<
> > >>
> http://us.mc1200.mail.yahoo.com/mc/compose?to=sebastjan.hri...@gmail.com>
> > >> > >> > wrote:
> >
> > >> > >> Hello,
> >
> > >> > >> how can I upload the file, as I see in the notification, this is
> no
> > >> > >> longer possible.
> >
> > >> > >> However, if you can imagine my situation:
> >
> > >> > >> I have data in columns from A to O and in rows from 1 to 100. The
> > >> data
> > >> > >> is in the same rows and columns in all workbooks.
> > >> > >> Now I need the data to be copied from all this workbooks (and all
> new
> > >> > >> ones I create) to a new workbook serving as a database.
> >
> > >> > >> However all columns allways contain some data, whereas the rows
> may
> > >> > >> not. It could be the case that only the 1st row contains any
> data.
> >
> > >> > >> I hope this helps a bit.
> >
> > >> > >> Thank you for the help.
> >
> > >> > >> Best regards,
> >
> > >> > >> seba
> >
> > >> > >> On 17 jan., 18:38, ashish koul <koul.ash...@gmail.com<
> > >> http://us.mc1200.mail.yahoo.com/mc/compose?to=koul.ash...@gmail.com>>
> > >> > >> wrote:
> > >> > >> > send us the sample workbook
> >
> > >> > >> > On Mon, Jan 17, 2011 at 12:10 AM, Seba <
> sebastjan.hri...@gmail.com
> > >> <
> http://us.mc1200.mail.yahoo.com/mc/compose?to=sebastjan.hri...@gmail.com
> >
> > >> > >> wrote:
> > >> > >> > > Hello all,
> >
> > >> > >> > > I have a question regarding building a database. I have a
> > >> workbook for
> > >> > >> > > each of my projects. I would like to have a macro, which
> would
> > >> > >> extract/
> > >> > >> > > copy certain data (always in the same rows and columns) to a
> new
> > >> > >> > > workbook, which would serve as a database.
> >
> > >> > >> > > Could anyone please help?
> >
> > >> > >> > > Thank you in advance.
> >
> > >> > >> > > Best regards,
> >
> > >> > >> > > seba
> >
> > >> > >> > > --
> >
> > >>
> ----------------------------------------------------------------------------------
> > >> > >> > > 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 athttp://www.excel-macros.blogspot.com
> > >> > >> > > 4. Learn VBA Macros athttp://www.quickvba.blogspot.com
> > >> > >> > > 5. Excel Tips and Tricks athttp://exceldailytip.blogspot.com
> >
> > >> > >> > > To post to this group, send email to
> > >> excel-macros@googlegroups.com<
> > >>
> http://us.mc1200.mail.yahoo.com/mc/compose?to=excel-macros@googlegrou...>
> >
> > >> > >> > > <><><><><><><><><><><><><><><><><><><><><><>
> > >> > >> > > Like our page on facebook , Just follow below link
> >
> > ...
> >
> > 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
>
--
*Regards*
* *
*Ashish Koul*
*akoul*.*blogspot*.com <http://akoul.blogspot.com/>
*akoul*.wordpress.com <http://akoul.wordpress.com/>
My Linkedin Profile <http://in.linkedin.com/pub/ashish-koul/10/400/830>
P Before printing, think about the environment.
--
----------------------------------------------------------------------------------
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
