Copying & pasting with a For...Next Loop

[BexleyManor]

Hi folks,

My head is rattled with the piece of code below:-

[vba]path = "C:\test File.xls"
Set Wkb = Workbooks.Open(path)
ThisWorkbook.Activate

dnum = Array("3", "4", "6", "7", "8", "11", "15", "16", "17", "18", _
"29", "38", "41", "62")

dep = Array("Site 3", "site 4", "Site 6", "Site 7", "Site 8", _
"Site 11", "Site 15", "Site 16", "Site 17", "Site 18", _
"Site 29", "Site 38", "Site 41", "Site 62")

ActiveSheet.Cells(1, 1).Select

For iii = LBound(dnum) To UBound(dnum)
For iiii = LBound(dep) To UBound(dep)
Selection.AutoFilter Field:=1, Criteria1:=dnum(iii)
Selection.CurrentRegion.Copy Destination:=Wkb.Sheets(dep(iiii)).Cells(1, 1)
Next iiii
Next iii[/vba]

To explain a little further, In the main workbook I need to perform filters on each depot number and then copy that into the workbook Test.xls on the corresponding worksheet. Everything seems to work fine except where it comes to copying the data to the Test.xls worksheets. I just seem to get the filter for dnum 52 copied to each sheet??

Any suggestions, I'm going nuts and developing a classic 1000yd stare with this!!

Thanks

[Ken Puls]

Hi Bexley,

At first glance, it looks like you're destination is the same on each iteration of the loop:

[vba]Destination:=Wkb.Sheets(dep(iiii)).Cells(1, 1)[/vba]

Try:
[vba]Destination:=Wkb.Sheets(dep(iiii)).Cells(Wkb.Sheets(dep(iiii)).Rows.Count, 1).End(xlup).offset(1,0)[/vba]

(I wrote it in the browser, so you may need to tweak it.)

HTH,

[BexleyManor]

Hi Ken,

I just tried your code however it does the same as mine did with the exception dnum 3 gets copied to every sheet instead of dnum 52, effectively the lbound of the dnum array whereas I had the ubound copied to each sheet!!

[Ken Puls]

Any way you can upload a santized workbook? It would be easier to step through the code, I think, with some source data. Only need a source workbook, too, not the destinations, as we can just create the sheets easily to match it.

[BexleyManor]

Certainly. I would walk across hot coals if it helps!! I've hacked the list down as it's some 26,000+ Lines.

I think it'ssomething to do with pasting special values but It's nearly 1am and I can't think straight now!


I'm also wondering if it would be easier to create a new workbook to export the data to??

[Ken Puls]

I'll try and take a look a little later tonight. If you can upload a file, that would be great.

[BexleyManor]

I'm so tired, I forgot to upload the workbook, arrrghhh!!

[XLGibbs]

Okay, I took a look, but only one of the files was in the zip...so i can't test out what you are trying to do.

However, your code does not specify to only copy the filter information, as you are using

[VBA]
Option Explicit
Sub CustSplit()
Dim WkbSource As Workbook, WkbDest As Workbook
Dim WksSource As Worksheet, WksDest As Worksheet
Dim strdate As String, path As String, destpath
Dim lngLABS As Long, lngCounter As Long, lngDEP As Long, lngDNUM As Long
Dim dnum(), dep(), labs()


lngCounter = 1 ' set your counter

Application.ScreenUpdating = False
Application.StatusBar = "Please wait, code at work...!!"
path = "C:\mainlist.xls"

Set WkbSource = ThisWorkbook
'''''''''''''''''''''''' create the header
With ActiveSheet
.Rows("1:1").Insert Shift:=xlDown

.Range(Cells(1, 1), Cells(1, 11)) = Array("Depot No.", "Customer No.", "Customer Name", "Post Code", "Telephone No.", _
"Mon", "Tues", "Wed", "Thurs", "Fri", "Operator")

End With

' set the source page
Set WksSource = WkbSource.Sheets("MainList")

'set the array for the filter as you had done
dnum = Array("1", "3", "4", "6", "7", "8", "11", "13", "15", "16", "17", "18", "19", "28", "31", "50", "52", "53", "90")

MkDir "C:\Test" 'make a path for the new files

destpath = "C:\Test\" 'string the pathway

''''''''loop through, filter and create workbook for each Depot
For lngDNUM = LBound(dnum) To UBound(dnum)

Workbooks.Add ' add a workbook
Set WkbDest = ActiveWorkbook
Set WksDest = WkbDest.Sheets(1)

WksDest.Name = "Depot " & dnum(lngDNUM)

With WksSource
.Activate
.Cells(1, 1).AutoFilter Field:=1, Criteria1:=dnum(lngDNUM)
Cells.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy WksDest.Cells(1, 1)

.ShowAllData
End With

WkbDest.SaveAs destpath & "Depot " & dnum(lngDNUM) 'name the file
WkbDest.Close False
Set WkbDest = Nothing

Next lngDNUM



Application.StatusBar = "Copying now complete."

Application.ScreenUpdating = True
End Sub
[/VBA]

I have simplified it quite a bit, but I only spent about 10 minutes on it...it works.

What it will do is cycle through your depot numbers, filter the list, add a workbook, name the sheet the depot #, then copy the filtered data to it, save the new file, close the new file. Rinse/Repeat.

Note that I add the directory in the code, so you would want to specify your desitnation or desired new folder name (it could be in a cell if you wish...)

Hope that helps. It worked with the file you uploaded..

[Ken Puls]

...your code does not specify to only copy the filter information, as you are using

How did I miss that?

Thanks, Pete!

[BexleyManor]

Hey Guys,

Wow, thanks for your suggestions. I ran Pete's code, which indeed does work, however it's a slight twist on what I was actually looking for. Rather than creating a new workbook for each copy action I would simply like the data to be pasted to the 2nd workbook into the 19 corresponding sheets.

I shall have a go at re-hashing Pete's fine code to see If I can't get this working myself, failing that I'll be back with tail between legs asking more questions!!

Catch you in the next episode...

[BexleyManor]

I'm back. No suprise there!!

Had a tinker with Pete's code but it was too much for me so I'm back again to see if anyone can tell me how to do the 'PasteSpecial' magic with my original code??

[vba]
For iiii = LBound(dep) To UBound(dep)
For iii = LBound(dnum) To UBound(dnum)
ActiveSheet.Cells(1, 1).Select
Selection.AutoFilter Field:=1, Criteria1:=dnum(iii)
Selection.CurrentRegion.Copy Destination:=Wkb.Sheets(dep(iiii)).Cells(1, 1)
Next iii
Next iiii[/vba]

Thanks, again...and again and again!!

[XLGibbs]

That is not a very hard modification to make..

Instead of WkbDest being the Workbook.Add open the file

Workbooks.Open etc etc.

Then set wkbDest = "that workbook"

Instead of renaming the workbook and sheet, you would just change the destination to

WkbDest.Sheets("Depot " & lngDNUM).Cells(1,1)

which would allow you to paste into the proper sheet.

Let us know if you get stuck..

[BexleyManor]

Pete, you are God like in you're ability to make the storm clouds in my mind pass!!

I shall have another tinker with your suggestion and report back the results later...

Thanks mate!!

[XLGibbs]

I would have posted the solution for you, but then you wouldn't learn nothin!

Let me know how it goes.

[BexleyManor]

It goes badly but I'm hacking away at it, determined not to be beaten!!

On my original code I have two arrays. The second with "site 1", "site 2" is a 'sanitized' version of my code yet it essential as I was using this to tie in with the actual sheet names on the second workbook. As I try to weave this back into your code I start to get lost.

Also, when I do the [VBA]Set Wkbdes = "C:\Test File.xls"[/VBA] I get an error??

I must sleep now, brain hurts!!

[Ken Puls]

I think you've got a bit of a mixture of code there...

If the workbook is closed:
[vba]Sub test()
Dim wbtest As Workbook
Set wbtest = Workbooks.Open("C:\temp\Book2.xls")

End Sub[/vba]

If it's open:
[vba]Sub test2()
Dim wbtest As Workbook
Set wbtest = Workbooks("Book2.xls")

End Sub[/vba]

[Ken Puls]

FYI, I'm not going to have any time to look at this tonight at all, but maybe post the code to date. I'm guessing that it's gone through a couple of revisions by now...

[BexleyManor]

Hi Ken, quite true the code keeps evolving though sadly my keeping up with it isn't. It took me an age to write my own sloppy code and kinda understand it so pete's magic has me scratching my head, heavily!!

Any further input or direction glady received but until then I'll keep plugging away!!

[XLGibbs]

Here is a quick mod which will open the destination file and filter/copy depot data to the appropriate tabs. Assumes the tab names are "Depot 1" "Depot 3" etc..

[vba]

Option Explicit
Sub CustSplit()
Dim WkbSource As Workbook, WkbDest As Workbook
Dim WksSource As Worksheet, WksDest As Worksheet
Dim strdate As String, path As String, destpath
Dim lngLABS As Long, lngCounter As Long, lngDEP As Long, lngDNUM As Long
Dim dnum(), dep(), labs()


Application.ScreenUpdating = False
Application.StatusBar = "Please wait, code at work...!!"
path = "C:\mainlist.xls"

Set WkbSource = ThisWorkbook
'''''''''''''''''''''''' create the header
With ActiveSheet
.Rows("1:1").Insert Shift:=xlDown

.Range(Cells(1, 1), Cells(1, 11)) = Array("Depot No.", "Customer No.", "Customer Name", _
"Post Code", "Telephone No.", _
"Mon", "Tues", "Wed", "Thurs", "Fri", "Operator")

End With

' set the source page
Set WksSource = WkbSource.Sheets("MainList")

Workbooks.Open "C:\Test\DestFile.xls"
Set WksDest = Workbooks("DestFile.xls")
'change the above file name and path to the desired

'set the array for the filter as you had done
dnum = Array("1", "3", "4", "6", "7", "8", "11", "13", "15", "16", "17", "18", "19", "28", _
"31", "50", "52", "53", "90")

''''''''loop through, filter and create workbook for each Depot
For lngDNUM = LBound(dnum) To UBound(dnum)

Workbooks.Add ' add a workbook

WkbDest.Name = "Depot " & dnum(lngDNUM)

With WksSource
.Activate
.Cells(1, 1).AutoFilter Field:=1, Criteria1:=dnum(lngDNUM)
Cells.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy WkbDest.Sheets("Depot " & dnum).Cells(1, 1)

.ShowAllData
End With

Next lngDNUM

WkbDest.Save 'saves the file
WkbDest.Close False 'closes the dest file
Set WkbDest = Nothing 'clear memory of object


MsgBox "Copying now complete."

Application.ScreenUpdating = True
End Sub


[/vba]

[BexleyManor]

Hi Pete,

I'm still at it with this one!!

I changed the file names and also included my array of actual depot names as the tabs do have specific names, not just Depot 1 etc.

I now get the code grinding to a halt at...

At the line [vba]Set WksDest = Workbooks("myfile.xls")[/vba] I get a type mismatch error??

Gotta go sleep now, 2.10am. zzzzzzz !!