Computer Hope
Software => Computer software => Topic started by: justin caise on April 16, 2009, 07:04:42 AM
-
Visual Basic is pretty cool - It allowed me to created a macro that will open a specified worksheet, copy data from certain cells, and paste it into a different worksheet with the press of two keys.
Is there a way to write it it so that the macro continues to open and copy from subsequent worksheets I,e. the next worksheet in the windows folder (which I have filed by date by the way) and pasting to the next cell in the destination worksheet? Or better yet open a worksheet a few down on the list in the windows folder?
The first screen shot I've posted shows how my exisiting macro works; data (yellow) is cut from specified cells and pasted into the desired worksheet - So Long As Both The Source and The Destination Worksheets Are Open.
I've highlighted in green the open worksheet. And then in the next screenshot I've highlighted the next file to be opened.
I'm trying to get the macro to open the file, transfer data, open the next file, and copy and paste data into the next cell in the destination worksheet (in this case "2009 Bi-annual data"). If I could do this for a full months folder it could potentially save me over 300 key strokes per month - and the time is very valuable!
The 3rd screenshot shows my macro in which I've copied the visual basic for opening the first worksheet - how would I make it open the next desired one?
Thanks, JC
[attachment deleted by admin]
-
Alright.
if I am understanding this correctly- you want to perform this operation on each file in that folder with the name:
09_04_DD.DAY
where DD is the day, to have the specific highlighted cells copied to a proper row in the resulting file?
Alright, I'll see what I can whip up. It might be a bit slow, since I'm haven't worked a whole lot with Excel, but it'll beat doing yourself, which I imagine is the point ;)
OK-
whipped this up.
Public Sub PerformCopyPaste()
'B9 D9 F9 G9 I9 J9 L9 M9 O9
'To
'B(row),C(Row) etc.
'change the following variables to change the "base" name for searches.
Dim BaseName As String, BaseFolder As String
Dim copyto As Worksheet
Dim FilesOpen() As String, Filecount As Long
Dim I As Long, CurrFile As String
'set to active sheet, the one your looking at.
Set copyto = Application.ActiveWorkbook.ActiveSheet
'you can change this for different worksheets in separate folders to match the proper folder name- IE, OCMMay09 would be next months, I imagine.
BaseFolder = "N:\wastewater\OCM flowmeter\OCMApril09\"
'BaseFolder = "D:\TestFolder\"
BaseName = "09_04_"
'Step one: loop through the proper files. we will iterate until we do not find a matching filename.
I = 1
Do
CurrFile = ""
'here, we need to make sure there is a leading digit of the number is less then ten.
CurrFile = BaseName
If I < 10 Then CurrFile = CurrFile & "0"
CurrFile = CurrFile & Trim(Str(I)) & ".DAY"
'Now, we add BaseFolder to Basename, and see if the resulting file path exists.
CurrFile = BaseFolder + CurrFile
'check it. we cheat and just use DIR$()....
If Dir$(CurrFile) <> "" Then
Debug.Print "found file, " & CurrFile
'if the Dir function returns a value, then the file exists. we will place it in the array to process afterward.
Filecount = Filecount + 1
ReDim Preserve FilesOpen(1 To Filecount)
FilesOpen(Filecount) = CurrFile
Else
Exit Do
End If
'add one to I, to look for next file.
I = I + 1
Loop
'now we process the filenames we found, present in the filesOpen() array created in the previous loop.
Dim usebook As Excel.Workbook, currsheet As Worksheet
For I = 1 To UBound(FilesOpen)
'Set usebook = Application.Workbooks.OpenText
Call Workbooks.OpenText(Filename:=FilesOpen(I), origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
TrailingMinusNumbers:=True)
Set usebook = Application.Workbooks(Application.Workbooks.Count)
'now that "usebook" is open, we will iterate on each sheet. there should only be one, but what the heck.
'For Each currsheet In usebook.Worksheets
Set currsheet = usebook.Worksheets(1)
'B9 D9 F9 G9 I9 J9 L9 M9 O9
'To
'B(row),C(Row) etc.
Dim B9, D9, F9, G9, I9, J9, L9, M9, O9
B9 = currsheet.Cells(9, 2)
D9 = currsheet.Cells(9, 4)
F9 = currsheet.Cells(9, 6)
G9 = currsheet.Cells(9, 7)
I9 = currsheet.Cells(9, 9)
J9 = currsheet.Cells(9, 10)
L9 = currsheet.Cells(9, 12)
M9 = currsheet.Cells(9, 13)
O9 = currsheet.Cells(9, 15)
'now, copy to active sheet.
'Row number "I", starting from B onwards.
copyto.Cells(I + 4, 2) = B9
copyto.Cells(I + 4, 3) = D9
copyto.Cells(I + 4, 4) = F9
copyto.Cells(I + 4, 5) = G9
copyto.Cells(I + 4, 6) = I9
copyto.Cells(I + 4, 7) = J9
copyto.Cells(I + 4, 8) = L9
copyto.Cells(I + 4, 9) = M9
copyto.Cells(I + 4, 10) = O9
' Next currsheet
usebook.Close
Next I
copyto.Visible = xlSheetVisible
End Sub
to use it, copy every thing between the first "sub" line and the "end Sub" into your macro. replace everything inside there as well.
(be sure to make a backup of what you have.)
it worked alright on my machine with some test data I rigged up, but please double-check this for me before you run it on any serious data :)
you can make adjustments to the rows if your keen enough by changing the lines:
B9 = currsheet.Cells(9, 2)
D9 = currsheet.Cells(9, 4)
F9 = currsheet.Cells(9, 6)
G9 = currsheet.Cells(9, 7)
I9 = currsheet.Cells(9, 9)
J9 = currsheet.Cells(9, 10)
L9 = currsheet.Cells(9, 12)
M9 = currsheet.Cells(9, 13)
O9 = currsheet.Cells(9, 15)
and those below it as appropriate. notice that you need to reference the cells here with numbers for the column rather then letters.
I hope this helps you. :)