VBA Copy & Paste

[chris9277]

Good morning/afternoon,

I am currently trying to find a code that will copy & paste specific information to a master file from other files within the same folder if 2 conditions have been met.

Basically I have a folder called "Idle Time Monitor"
Within this folder I have a workbook named "Master Sheets" & numerous other workbooks saved like:

DispatcherActions_20090827_Employee_187.xls
DispatcherActions_20100125_Employee_113.xls
DispatcherActions_20100125_Employee_205.xls
DispatcherActions_20100125_Employee_250.xls
DispatcherActions_20100125_Employee_251.xls
DispatcherActions_20100928_Employee_150.xls
DispatcherActions_20110124_Employee_169.xls
DispatcherActions_20110125_Employee_169.xls
DispatcherActions_20110126_Employee_169.xls
DispatcherActions_20110127_Employee_169.xls
DispatcherActions_20110202_Employee_169.xls

Now in the "Master Sheets" workbook the 1st tab is called 'data analysis' which is used to look at all the other tabs in the same workbook. I then have numerous other tabs (sheet 2 onwards). Now what I would like to be able to do is put a 3 digit number in B3 & an 8 digit number in b4 in any of the tabs & it will then look for that workbook that ends with them 3 digits & also has them exact 8 digits within the middle of it's workbook name & then copy the information from H2:I102 of that matching workbook & paste it into A7:A107 of the relevant tab in the "Master Sheets" in which the criteria has been typed.

I would preferably like to be able to click on a macro button on sheet 1 (Data analysis tab) after I have put the information into B3 & B4 of all the tabs & then it copy & paste through all the information.

Is this at all possible, my knowledge of VBA is poor

[mancubus]

if i get the point correctly, you may play around with the following. test on a backup of your file.

copy to a standard module in Master Sheets workbook.


Const str1 As String = "DispatcherActions_"
Const str2 As String = "_Employee_"
'

Sub copy_from_wbs()

Dim myPath As String
Dim mstr As Workbook, wbk As Workbook
Dim sht As Worksheet

Application.ScreenUpdating = False

On Error GoTo Error_Handler

Set mstr = ThisWorkbook
Set myPath = ThisWorkbook.Path

For Each sht In Worksheets
If sht.Name <> "data analysis" Then
sth.Activate
Set wbk = Workbooks.Open(myPath & str1 & Range("B4").Value & Range("B3").Value & str2 & ".xls")
wbk.Sheets("Sheet1").Range("H2:I102").Copy Destination:=mstr.sht.Range("A7") 'change Sheet1 to actual sheet name
wbk.Close savechanges:=False
End If
Next sht

Error_Handler:
If Err <> 0 Then
Err.Clear
Resume Next
End If

Application.ScreenUpdating = True

End Sub

[chris9277]

Mancubus,

Thank you for taking your time to do this for me it's very much appreciated, I have been trying all week & must have messaged every forum I could find but to no avail. Now I have copied your macro & pasted it into a standard sheet within the workbook. The problem I am now experiencing is when I try & run it, it highlights the following:

set MyPath = This Workbook.path

& then flags up with the message:

Error message:
Object required

Now I'm a little wet behind the ears when it comes to VBA & was wondering if you could tell me what I'm doing wrong.

Many thanks

Chris

[Kenneth Hobs]

There is no space character between This and Workbook.path.

[chris9277]

Hi Kenneth,

Sorry I put the space in by mistake, the VBA itself as shown above which was kindly done by Mancubus is exactly how I pasted it in but still get the message.

Thanks

chris.

[Kenneth Hobs]

oic, Change:
Set myPath = ThisWorkbook.Path
to:
myPath = ThisWorkbook.Path

This happened because myPath is a string an not an object.

[chris9277]

Kenneth,

Now it does run but no information is pulled through. The information it is looking at is:

Column H is 25/01/2011 16:32:03

column I is
00:19:01

could this be affecting the data being pulled through. Also the 1st tab is sheet 1 but that tab is called data analysis which I don't want the macro to look at. It's every tab after that which contains data in cells B4 & B3 which meet the requirement for pulling the information from the relevant workbook.

many thanks

Chris

[Kenneth Hobs]

You can use F8 to step through the code to see what is going on.

The first thing that I see is that myPath does not have a trailing backslash so do this:
myPath = ThisWorkbook.Path & "\"

Also, change:
Set wbk = Workbooks.Open(myPath & str1 & Range("B4").Value & Range("B3").Value & str2 & ".xls")

to:
Set wbk = Workbooks.Open(myPath & str1 & sht.Range("B4").Value & sht.Range("B3").Value & str2 & ".xls")

[chris9277]

The macro is running fine but it's still not pulling any information through.

Does this help - This is a image of each of my tabs in which I would like the information to be pasted too.

Idle Time Monitoring SystemUser ID:169Date:20110124StartedTime spentIdle TimeReasonComments00:00:0000:00:0000:00:0000:00:0000:00:0000:00:0000:00:000 0:00:0000:00:0000:00:0000:00:0000:00:0000:00:0000:00:0000:00:00


This is the layout of one of the workbooks where the data is pulled from the last 2 columns being H & I:

StreetStreet nameWorkstationColorActionProductAmountStartedTime spent2FFOODS 1OTHERS 1YELLOW^End despatch6516038123/01/2011 16:07:5100:14:222FFOODS 1OTHERS 1YELLOW^End despatch286216043223/01/2011 16:22:4500:04:442FFOODS 1OTHERS 1YELLOW^End despatch112816019423/01/2011 16:27:3300:08:552FFOODS 1OTHERS 1YELLOW^End despatch14316022223/01/2011 16:36:3000:07:553OTHERS 1OTHERS 1YELLOW^End despatch288503043223/01/2011 16:44:3800:08:443OTHERS 1OTHERS 1YELLOW^End despatch244403011923/01/2011 16:53:3000:05:323OTHERS 1OTHERS 1YELLOW^End despatch4659000523/01/2011 17:19:1700:00:273OTHERS 1OTHERS 1YELLOW^End despatch47730302023/01/2011 17:19:5000:01:163OTHERS 1OTHERS 1YELLOW^End despatch3169000523/01/2011 17:21:1400:00:323OTHERS 1OTHERS 1YELLOW^End despatch45980301823/01/2011 17:27:5200:01:283OTHERS 1OTHERS 1YELLOW^End despatch3634700823/01/2011 17:29:3600:01:173OTHERS 1OTHERS 1YELLOW^End despatch32530303023/01/2011 17:31:1500:02:303OTHERS 1OTHERS 1YELLOW^End despatch33750307223/01/2011 17:33:4900:02:193OTHERS 1OTHERS 1YELLOW^End despatch546030623/01/2011 17:36:1800:01:113OTHERS 1OTHERS 1YELLOW^End despatch4739000223/01/2011 17:37:3300:00:223OTHERS 1OTHERS 1YELLOW^End despatch4668000223/01/2011 17:37:5600:00:323OTHERS 1OTHERS 1YELLOW^End despatch2804000223/01/2011 17:38:3100:00:41

[Kenneth Hobs]

That does not help. One of the things that this site does is that it allows attachments. Working with real data usually lets people help you more. Of course this means that you have to work up a small file that represents what you would do with the actual file.

Looking at the string for the slave workbook names, I still think that is where you are stuck. The only real thing that I changed was the string to build the workbook names. This lets us see what is going on by using debug. The results of debug.print are shown in the Immediate Window.

Also note that each of the slave file's data is copied from their tab named Sheet1. If you have some other tab name, then you need to change it in the code.

Sub copy_from_wbs()
Dim myPath As String
Dim mstr As Workbook, wbk As Workbook
Dim sht As Worksheet
Dim s As String

Application.ScreenUpdating = False

On Error GoTo Error_Handler

Set mstr = ThisWorkbook
myPath = ThisWorkbook.Path & "\"

For Each sht In Worksheets
If sht.Name <> "data analysis" Then
s = myPath & "DispatcherActions_" & sht.Range("B4").Value & _
"_Employee_" & sht.Range("B3").Value & ".xls"
Debug.Print sht.Name
Debug.Print Dir(s) 'Dir(s) will tell us if the workbook exists.
Debug.Print s
If Dir(s) = "" Then GoTo NextSht
Set wbk = Workbooks.Open(s)
wbk.Sheets("Sheet1").Range("H2:I102").Copy Destination:=mstr.sht.Range("A7") 'change Sheet1 to actual sheet name
wbk.Close savechanges:=False
End If
NextSht:
Next sht

Error_Handler:
If Err <> 0 Then
Err.Clear
Resume Next
End If

Application.ScreenUpdating = True
End Sub

[chris9277]

http://m.facebook.com/photo.php?fbid=1784895417168&set=a.1648879936866.2090165.1082983453&refid=7

Hopefully the attached image will show as im restricted from the computer im working off. If not then I will send it later.

Regards,

chris.

[chris9277]

Please find attached the master sheets

[chris9277]

These next 2 files are just 2 of the many that are all held in a folder called "Idle Time Monitor" along with the "Master sheets" workbook

[chris9277]

I hope this makes it a little easier to understand.

[mancubus]

mostly, to ease things, one can copy-paste available codes and modify to suit new scenario.

this was the case. sorry for the troubles and thanks to Kenneth for corrections.

[chris9277]

Kenneth,

I can't see if the files I attached have been sent from this end as there is no link to open them. I was just wondering did you receive them? I have also copied & pasted your latest code but again nothing happened. I have a feeling it's probably something simple that I have either failed to spot or inform you of. So hopefully these 3 file examples will make it clearer.

Thanks

Chris

[mancubus]

working with your sample files, below code, a simple copy-paste macro with lines borrowed from Kenneth :whistle:, worked for me.



Sub copy_from_wbs()

Dim myPath As String
Dim mstr As Workbook, wbk As Workbook
Dim sht As Worksheet
Dim s As String

Application.ScreenUpdating = False

On Error GoTo Error_Handler

Set mstr = ThisWorkbook
myPath = ThisWorkbook.Path & "\"

For Each sht In Worksheets
If sht.Name <> "data analysis" Then
sht.Activate
s = myPath & "DispatcherActions_" & sht.Range("B4").Value & _
"_Employee_" & sht.Range("B3").Value & ".xls"
Set wbk = Workbooks.Open(s)
wbk.Sheets("Dispatch_actions").Range("H2:I102").Copy
mstr.Activate
sht.Range("A7").PasteSpecial xlPasteAll
Application.CutCopyMode = False
wbk.Close savechanges:=False
End If
Next sht

Error_Handler:
If Err <> 0 Then
Err.Clear
Resume Next
End If

Application.ScreenUpdating = True

End Sub

[chris9277]

WAHOOOOOOOOOOOO, That is exactly what I wanted to happen. Thanks guys your time & effort has been greatly appreciated. Can't thank you enough.:friends:

[mancubus]

cheers...

:beerchug:

[Kenneth Hobs]

Good job mancubus!

Chris, in this example, I set it to only get the two columns of data in rows 2 to the last row before the total in the slave files. As you probably noticed, Chris changed the sheet name from Sheet1 to the sheet named in your slave files. I just used index sheet 1. A copy/paste as mancubus used is easy to use. I used set value method that does not require Activate just for kicks.

I am not sure why you could not see your posts with the links. For future posts, you can zip the files if you need to include more than one or reduce size.

Sub copy_from_wbs2()
Dim myPath As String
Dim mstr As Workbook, wbk As Workbook
Dim sht As Worksheet
Dim s As String, r As Range

Application.ScreenUpdating = False

On Error GoTo Error_Handler

Set mstr = ThisWorkbook
myPath = ThisWorkbook.Path & "\"

For Each sht In Worksheets
If sht.Name <> "Data Analysis" Then
s = myPath & "DispatcherActions_" & sht.Range("B4").Value & _
"_Employee_" & sht.Range("B3").Value & ".xls"
If Dir(s) = "" Then GoTo NextSht
Set wbk = Workbooks.Open(s)
Set r = wbk.Sheets(1).Range("H2", wbk.Sheets(1).Range("I2").End(xlDown).Offset(-1))
mstr.Worksheets(sht.Name).Range("A7").Resize(r.Rows.Count, r.Columns.Count).Value = _
r.Value
wbk.Close savechanges:=False
End If
NextSht:
Next sht

Error_Handler:
If Err <> 0 Then
Err.Clear
Resume Next
End If

Application.ScreenUpdating = True
End Sub

[mancubus]

thanks Kenneth.

not an elegant one, but i think, not that bad.

btw, this method is my favorite for pulling data:


mstr.Worksheets(sht.Name).Range("A7").Resize(r.Rows.Count, r.Columns.Count).Value = r.Value