VB code from VBA

Topic

New Reply

I will try to explain as clear as possible my question/problem – I am running XP ; VB6 and excel 2000

I download a series of worksheets and copy a specific range to a mother workbook on a weekly basis.

I have gone through and recorded a macro that does this without no problem. Her is the macro:

Code:

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 5/1/2015 by jp enterprises
'

'
    Application.CommandBars("Clipboard").Visible = True
    Range("A1").Select
    Windows("LS_5K WTFook_Wk 1.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 2.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 3.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet3").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 4.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet4").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 5.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet5").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 6.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet6").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 7.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet7").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.WindowState = xlMinimized
    Windows("LS_5K WTFook_Wk 8.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet8").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 9.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Application.WindowState = xlMinimized
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet9").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 10.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet10").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 11.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet11").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 12.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet12").Select
    Range("A1").Select
    ActiveSheet.Paste
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    ActiveWindow.ScrollWorkbookTabs Sheets:=1
    Windows("LS_5K WTFook_Wk 13.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet13").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 14.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet14").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 15.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet15").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 16.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet16").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 17.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet17").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 18.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet18").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 19.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet19").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 20.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet20").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.Run Range("AUTOSAVE.XLA!mcs02.OnTime")
    Windows("LS_5K WTFook_Wk 21.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet21").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 22.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet22").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 23.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet23").Select
    Range("A1").Select
    ActiveSheet.Paste
    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Windows("LS_5K WTFook_Wk 24.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet24").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 25.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet25").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 26.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet26").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 27.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet27").Select
    Range("A1").Select
    ActiveSheet.Paste
    Windows("LS_5K WTFook_Wk 28.csv").Activate
    Range("A1:J23").Select
    Range("J23").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Windows("LS_5K WTFook.xls").Activate
    Sheets("Sheet28").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    CommandBars("Clipboard").Controls("Clear Clipboard").Execute
    Application.CommandBars("Clipboard").Visible = False

End Sub

I know there is a lot of extraneous code in this macro that I could trim out ; I can design the form in VB6 with no problem ; I thought about using a txt box and then manually typing in the name of the mother workbook. I know I need to use string variables for the worksheets but there is my wall. How do I get VB6 (I can start excel within VB6 with no problem too) to go to that directory with those *.csv files and that workbook and copy a specific range? I do this 75 times ; I presently highlight all the files in that directory; hit enter which starts excel and then go to the macro that does the work

Thanks and forgive me if this isnt in the correct section

Jeff

Reply | Quote

Replies

Do you need to do it in VB6? Leaving it in VBA in Excel allows others to work on it / fix issues easily. It’s also easy to find code / help in VBA.

cheers, Paul

Reply | Quote

Do you need to do it in VB6? Leaving it in VBA in Excel allows others to work on it / fix issues easily. It’s also easy to find code / help in VBA.

cheers, Paul

Yes I would like it to be in VB6 . I’m a lone wolf and do not have anyone else that would even remotely using the code. I wouldn’t care if inside VB6 I’d call this code as a sub ; All I’m looking for is a hint or a snippet to point me the way to utilize the code in other ways. If I see a possible solution I can take it from there ; again I understand how to

1 start excel
2 open an existing WB
3 Deal and reference worksheets

Thanks for reply

Jeff

Reply | Quote

Personally, I’d leave it as an Excel macro, coded along the lines of:

Code:

Sub GetData()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim xlTgt As Workbook, xlSrc As Workbook, i As Long
Set xlTgt = ActiveWorkbook
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "*.csv", vbNormal)
While strFile  ""
  i = i + 1
  If xlTgt.Sheets.Count < i Then xlTgt.Sheets.Add
  Set xlSrc = Workbooks.Open(Filename:=strFolder & "" & strFile, AddToMru:=False)
  With xlSrc
    .Sheets(1).Range("A1:J23").Copy Destination:=xlTgt.Sheets(i).Range("A1")
    .Close SaveChanges:=False
  End With
  strFile = Dir()
Wend
Set xlTgt = Nothing: Set xlSrc = Nothing
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

Note that the above code includes a folder browser. Even that could be omitted if you always want to process files only from a particular folder.

Yes, you could implement something similar with VB6 but the overheads are unlikely to result in quicker processing (your existing code is especially inefficient, but that's a limitation of using the macro recorder) and would be harder to maintain.

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote

Before we go on further I see a command in the macro that I dont understand: I do understand the other aspects of this macro

“Wend”

Forgive me for being so newbie-ish about this and I really thank you both for helping out someone with way older technology and software

Jeff

Personally, I’d leave it as an Excel macro, coded along the lines of:

Code:

Sub GetData()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim xlTgt As Workbook, xlSrc As Workbook, i As Long
Set xlTgt = ActiveWorkbook
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "*.csv", vbNormal)
While strFile  ""
  i = i + 1
  If xlTgt.Sheets.Count < i Then xlTgt.Sheets.Add
  Set xlSrc = Workbooks.Open(Filename:=strFolder & "" & strFile, AddToMru:=False)
  With xlSrc
    .Sheets(1).Range("A1:J23").Copy Destination:=xlTgt.Sheets(i).Range("A1")
    .Close SaveChanges:=False
  End With
  strFile = Dir()
Wend
Set xlTgt = Nothing: Set xlSrc = Nothing
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

Note that the above code includes a folder browser. Even that could be omitted if you always want to process files only from a particular folder.

Yes, you could implement something similar with VB6 but the overheads are unlikely to result in quicker processing (your existing code is especially inefficient, but that's a limitation of using the macro recorder) and would be harder to maintain.

Reply | Quote

Wend would be the end for the While.

cheers, Paul

Reply | Quote

Wend would be the end for the While.

cheers, Paul

Thanks much for the reply – (I learned something new – in all the code that I’ve seen I never ran across that command)

Now my other problem is that if I wanted to use this as a macro inside a workbook (all 28 of them) When I customize a toolbar and assign the macro to that custom button ; The same macro comes with every workbook. For some reason I cannot keep the macro desired that will work with that specific workbook; I understand that I could put 28 macros in the personal workbook but there is one thing I forgot to mention ;

I have 3 different ranges that I deal with in copying and pasting depending on the workbook.

Thanks so much

Jeff

Reply | Quote

Jeff,

I would propose that you place the following code in each of your workbooks:

Code:

Public rngThisWkBk As Range
Public wkbSource    as workbook
Sub Auto_Open()

   Set rngThisWkBk = Range("D42:Z80")  '*** Adjust as appropriate ***
   Set wkbSource = ActiveWorkbook

End Sub

Next you rewrite your code to use the variables rngThisWkBk and wkbSource then store this macro in your Personal Macro workbook.

Lastly link your custom toolbar button the the macro in the Personal Macro workbook.

Done and you only have one macro to maintain.

BTW: I wasn’t sure if the workbook in question would be the source or destination for the copy so you can change the variable name accordingly.

HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

You could even pop up an input box to allow you to enter the range – don’t know if you can use a range select manually.

cheers, Paul

Reply | Quote

You could even pop up an input box to allow you to enter the range – don’t know if you can use a range select manually.

cheers, Paul

I have 3 specific ranges (they don’t change) that I deal with depending on the workbook/worksheets ; the workbook I’m dealing with is the destination in a 3 scenarios.

Thanks to all that have given me a map to the “gold mine” to get this done. Will try all these solutions very soon in order to close the thread

How could use that input box within VBA? I know how to do it in VB6.

Reply | Quote

For example:

Code:

Sub GetData()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strRng As String
Dim xlTgt As Workbook, xlSrc As Workbook, i As Long
Set xlTgt = ActiveWorkbook
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strRng = InputBox(Prompt:="Source range to copy", Title:="Range Input", Default:="A1:J10")
strFile = Dir(strFolder & "*.csv", vbNormal)
While strFile  ""
  i = i + 1
  If xlTgt.Sheets.Count < i Then xlTgt.Sheets.Add
  Set xlSrc = Workbooks.Open(Filename:=strFolder & "" & strFile, AddToMru:=False)
  With xlSrc
    .Sheets(1).Range(strRng).Copy Destination:=xlTgt.Sheets(i).Range("A1")
    .Close SaveChanges:=False
  End With
  strFile = Dir()
Wend
Set xlTgt = Nothing: Set xlSrc = Nothing
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote

This code will be looked over and tested tonight – Thank you again All of you have taken my hobby status to warp speed

Jeff

Reply | Quote

Ran to my satisfaction thanks to all

Jeff

Reply | Quote