PlutoX
09-04-2018, 05:19 AM
Hi guys,
first time poster here :)
I would need some help adjusting the value range of my VBA code.
My User Form looks like this: https://i.stack.imgur.com/eSUkP.png
I have a listbox with workbooks (wb1, wb2, wb3...) and a workbook template(wb_template).
I need to copy/paste values from wb1 to wb_template if certain conditions are met.
As you can see in the code below, the value range is fixed. What I would need is defining conditions, which should be met before initialising the copy/paste procedure.
So far I think that the Range.Find and Range.Offset Methods are the way to go, but I'm not sure how to achieve this, as I'm pretty new to the VBA coding...
I would need to define the following conditions:
Condition 1: look for and copy certain keyword in wb1 and paste/rename it in wb_template(specific range - sheet/cell). Example: https://i.stack.imgur.com/bdv7d.png
Condition 2: look for certain keyword in wb1, copy the value of the adjoining cell and paste it in wb_template(specific range - sheet/cell). Example: https://i.stack.imgur.com/JVpFZ.png
The loop should work like this:
Check sheet1 of wb1 according to the conditions
If conditions are met - transfer the values from wb1 to wb_template
Save wb_template as new workbook
Repeat procedure for sheet2, sheet3, sheet4 and so on...
Then repeat process for the next workbook in the listbox
So, in the end I should have new workbooks for every sheet of the workbooks(wb1, wb2, wb3...) of the listbox. Overview: https://i.stack.imgur.com/mmeWZ.png
I have everything set up so far - my code as of now loops through every sheet of my workbook and copy/pastes data according to a fixed range. The only thing I need are those conditions instead of the fixed range.
The VBA code so far:
Transfer-Button
PublicSub TransferFile(TemplateFile AsString, SourceFile AsString)
Dim wbSource As Workbook
Set wbSource = Workbooks.Open(SourceFile)'open source
Dim wbTemplate As Workbook
Dim NewWbName AsString
Dim wsSource As Worksheet
ForEach wsSource In wbSource.Worksheets 'loop through all worksheets in source workbook
Set wbTemplate = Workbooks.Open(TemplateFile)'open new template
'/* Definition of the value range */
With wbTemplate.Worksheets("Sheet1")
.Range("A2").Value = wsSource.Range("A2").Value
.Range("A3").Value = wsSource.Range("A3").Value
.Range("B2").Value = wsSource.Range("B2").Value
.Range("B3").Value = wsSource.Range("B3").Value
EndWith
NewWbName = Left(wbSource.Name, InStr(wbSource.Name,".")-1)
wbTemplate.SaveAs wbSource.Path & Application.PathSeparator & NewWbName &"_New.xlsx"
wbTemplate.Close False'close template
Next wsSource
wbSource.Close False'close source
EndSub
Browse Files Button - I guess not relevant for my question
PrivateSub CommandButton1_Click()
Dim fNames AsVariant
WithMe
fNames = Application.GetOpenFilename("Excel File(s) (*.xls*),*.xls*",,,,True)
If IsArray(fNames)Then.ListBox1.List = fNames
EndWith
EndSub
PrivateSub CommandButton2_Click()
Dim i AsInteger
'/* full path to the template file */
Const mytemplate AsString="C:\Users\PlutoX\Desktop\Excel-Folder\wb_template.xlsx"
WithMe
With.ListBox1
'/* iterate listbox items */
For i =0To.ListCount -1
'/* transfer the files using the generic procedure */
Transferfile mytemplate,.List(i,0)
Next
EndWith
EndWith
EndSub
Thanks for the help!
first time poster here :)
I would need some help adjusting the value range of my VBA code.
My User Form looks like this: https://i.stack.imgur.com/eSUkP.png
I have a listbox with workbooks (wb1, wb2, wb3...) and a workbook template(wb_template).
I need to copy/paste values from wb1 to wb_template if certain conditions are met.
As you can see in the code below, the value range is fixed. What I would need is defining conditions, which should be met before initialising the copy/paste procedure.
So far I think that the Range.Find and Range.Offset Methods are the way to go, but I'm not sure how to achieve this, as I'm pretty new to the VBA coding...
I would need to define the following conditions:
Condition 1: look for and copy certain keyword in wb1 and paste/rename it in wb_template(specific range - sheet/cell). Example: https://i.stack.imgur.com/bdv7d.png
Condition 2: look for certain keyword in wb1, copy the value of the adjoining cell and paste it in wb_template(specific range - sheet/cell). Example: https://i.stack.imgur.com/JVpFZ.png
The loop should work like this:
Check sheet1 of wb1 according to the conditions
If conditions are met - transfer the values from wb1 to wb_template
Save wb_template as new workbook
Repeat procedure for sheet2, sheet3, sheet4 and so on...
Then repeat process for the next workbook in the listbox
So, in the end I should have new workbooks for every sheet of the workbooks(wb1, wb2, wb3...) of the listbox. Overview: https://i.stack.imgur.com/mmeWZ.png
I have everything set up so far - my code as of now loops through every sheet of my workbook and copy/pastes data according to a fixed range. The only thing I need are those conditions instead of the fixed range.
The VBA code so far:
Transfer-Button
PublicSub TransferFile(TemplateFile AsString, SourceFile AsString)
Dim wbSource As Workbook
Set wbSource = Workbooks.Open(SourceFile)'open source
Dim wbTemplate As Workbook
Dim NewWbName AsString
Dim wsSource As Worksheet
ForEach wsSource In wbSource.Worksheets 'loop through all worksheets in source workbook
Set wbTemplate = Workbooks.Open(TemplateFile)'open new template
'/* Definition of the value range */
With wbTemplate.Worksheets("Sheet1")
.Range("A2").Value = wsSource.Range("A2").Value
.Range("A3").Value = wsSource.Range("A3").Value
.Range("B2").Value = wsSource.Range("B2").Value
.Range("B3").Value = wsSource.Range("B3").Value
EndWith
NewWbName = Left(wbSource.Name, InStr(wbSource.Name,".")-1)
wbTemplate.SaveAs wbSource.Path & Application.PathSeparator & NewWbName &"_New.xlsx"
wbTemplate.Close False'close template
Next wsSource
wbSource.Close False'close source
EndSub
Browse Files Button - I guess not relevant for my question
PrivateSub CommandButton1_Click()
Dim fNames AsVariant
WithMe
fNames = Application.GetOpenFilename("Excel File(s) (*.xls*),*.xls*",,,,True)
If IsArray(fNames)Then.ListBox1.List = fNames
EndWith
EndSub
PrivateSub CommandButton2_Click()
Dim i AsInteger
'/* full path to the template file */
Const mytemplate AsString="C:\Users\PlutoX\Desktop\Excel-Folder\wb_template.xlsx"
WithMe
With.ListBox1
'/* iterate listbox items */
For i =0To.ListCount -1
'/* transfer the files using the generic procedure */
Transferfile mytemplate,.List(i,0)
Next
EndWith
EndWith
EndSub
Thanks for the help!