LinkBack URL
About LinkBacks
Dear all,
I need a help to arranged my data. I have daily climate data for 16 stations as in sheet 1 to 21 and I want to extract each station's data in a single sheet as in samaru sheet. Thank you
Dear all,
I need a help to arranged my data. I have daily climate data for 16 stations as in sheet 1 to 21 and I want to extract each station's data in a single sheet as in samaru sheet. Thank you
Try this:
Sub akuma() 'Had to make a couple of assumptions based upon the information provided Dim ws As Worksheet Dim arrStations As Variant Dim LR As Long, i As Long Dim r As Range Application.ScreenUpdating = False arrStations = Sheet1.Range(Sheet1.Cells(1, 2), Sheet1.Cells(1, Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column)) 'define sheets that will be skipped in worksheet loop For Each ws In Worksheets If IsError(Application.Match(ws.Name, arrStations, 0)) Then 'only process sheets not in array LR = ws.Range("A" & Rows.Count).End(xlUp).Row For i = 2 To ws.Cells(1, Columns.Count).End(xlToLeft).Column If Evaluate("=ISREF('" & ws.Cells(1, i).Value & "'!A1)") Then Sheets(ws.Cells(1, i).Value).Range("A1").Value = ws.Range("A1").Value Sheets(ws.Cells(1, i).Value).Range("B1").Value = ws.Cells(1, i).Value Set r = Union(ws.Range("A2:A" & LR), ws.Range(ws.Cells(2, i), ws.Cells(LR, i))) r.Copy Sheets(ws.Cells(1, i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1) End If Next i End If Next ws Application.ScreenUpdating = True End Sub
If you are happy with my response please click the * in the lower left of my post.
Dear Stbkynts,
I don't understand much about coding so I wish if you can show me using my excel file. However, I saw Long and I assume longitude in your script. The data are purely stations based and I only want to rearrange the data in such a way that each station's data is in separate sheet instead of 16 stations. Please use my data and work on it. Thanks
Here's my understanding.
Sub test() Dim ws As Worksheet, i As Long, wsName As String Dim dic As Object, flg As Boolean Set dic = CreateObject("Scripting.Dictionary") dic.CompareMode = 1 For Each ws In Worksheets If ws.Name Like "Sheet*" Then With ws.Cells(1).CurrentRegion If .Rows.Count > 1 Then For i = 2 To .Columns.Count wsName = .Cells(1, i).Value If Not dic.exists(wsName) Then dic(wsName) = Empty: flg = True End If CheckSheet wsName, Union(ws.Cells(1), ws.Cells(1, i)), flg Union(.Columns(1), .Columns(i)).Offset(1).Copy _ Sheets(wsName).Range("a" & Rows.Count).End(xlUp)(2) Next End If End With flg = False End If Next End Sub Private Sub CheckSheet(ByVal wsName As String, rng As Range, flg As Boolean) Dim ws As Worksheet On Error Resume Next Set ws = Sheets(wsName) On Error GoTo 0 If ws Is Nothing Then Worksheets.Add(after:=Sheets(Sheets.Count)).Name = wsName End If If flg Then Sheets(wsName).Cells.Clear rng.Copy Sheets(wsName).Cells(1) End If End Sub
Dear Jindo,
thank you very much for your reply. Please can you work it on my excel file? I don't know much about coding so I couldn't use the script you wrote. Thank you
Not even close.However, I saw Long and I assume longitude in your script.
That is exactly what I did and it does exactly what you asked.Please use my data and work on it.
Okay. Please can you tell me how I can use the script?I copy the script to my excel data but I don't actually know how to use it so it didn't work. I thought you will attached the excel file you worked on it here. Thanks
I am not able to attach files from this location. You can do a google search on how to add code to the Visual Basic Editor. Here is a small example utilizing a command button. You don't need to use a command button if you don't want to; instead you can put the code in its own module to be called directly.
http://www.excel-easy.com/vba/create-a-macro.html
Some worksheets are deleted due to the size limit of attachment, but doesn't matter.
My code reads all the data from worksheets that named "Sheet#".
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
Register To Reply
Bookmarks