Hi preeti,
This code covers your task, you can run it and enjoy. It was
interesting problem to solve. Please tell us does it work for you.
Sub automate()
Dim i, j, k, n, myfile, mySheet
Call ListWorkSheetNames
myfile = ActiveWorkbook.FullName
Sheets("main sheet").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
Sheets("SheetList").Select
Range("A1").Select
i = 1
Range("A1:A2").Select
Range(Selection, Selection.End(xlDown)).Select
j = Range(Selection, Selection.End(xlDown)).Count
Range("A1").Select
For i = 1 To j
Worksheets("SheetList").Cells(i, 1).Select
Worksheets("SheetList").Cells(i, 1).Activate
If Not (ActiveCell.Value = "main sheet") Then
If Not (ActiveCell.Value = "SheetList") Then
mySheet = ActiveCell.Value
Sheets(mySheet).Select
Worksheets(mySheet).Cells(1, 1).Select
Range("A1:B1").Select
Range(Selection, Selection.End(xlToRight)).Select
k = Range(Selection, Selection.End(xlToRight)).Count
Range("A1").Select
n = 1
While Not (n > k)
Worksheets("main sheet").Cells(1, n).Value =
Worksheets(mySheet).Cells(1, n).Value
n = n + 1
Wend
Call mysql(myfile, mySheet, k)
End If
End If
Sheets("SheetList").Select
Next i
Sheets("SheetList").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("main sheet").Select
MsgBox ("done!")
End Sub
Sub ListWorkSheetNames()
Dim Sheetnames
Sheetnames = Sheets.Count
Sheets.Add
ActiveSheet.Name = "SheetList"
Sheets("SheetList").Move after:=Sheets(Sheetnames + 1)
For i = 1 To Sheetnames
Range("A" & i) = Sheets(i).Name
Next i
End Sub
Sub mysql(myfile, mySheet, k)
Dim m, h, d, r
On Error Resume Next
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")
objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & myfile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes;"";"
objRecordset.Open "Select distinct * FROM [" & mySheet & "$] ", _
objConnection, adOpenStatic, adLockOptimistic, adCmdText
Do Until objRecordset.EOF
d = 1
Sheets("main sheet").Select
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
r = Range(Selection, Selection.End(xlDown)).Count
Range("A1").Select
If (r = 65536) Then
m = 2
Else
m = r + 1
End If
h = 1
While Not (d > k)
ThisWorkbook.Sheets("main sheet").Cells(m, h).Value =
objRecordset.Fields.Item(Worksheets("main sheet").Cells(1, d).Value)
d = d + 1
h = h + 1
Wend
objRecordset.MoveNext
Loop
End Sub
On 21 Лип, 18:40, preeti vora <[email protected]> wrote:
> Hi team
>
> i have one excel file there is 10 to 15 sheet different but i want to marge
> in one sheet is that possible to do???
>
> --
> Regards,
>
> Preeti Vora.
>
> data.xls
> 24KДивитисьЗавантажити
--
----------------------------------------------------------------------------------
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 [email protected]
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 7000 subscribers worldwide and receive many nice notes about the
learning and support from the group.Let friends and co-workers know they can
subscribe to group at http://groups.google.com/group/excel-macros/subscribe
