Set destination sheet based on variable and paste data assistance
in [Programming]
|
From: fishy on 13 Apr 2010 03:49 I have an excel book that works through each of the teams based on a range on the control sheet (Teamexports), opens its respective team file based on the date and filepath (Update_Data) and then I want it to copy the data to the named team tab already in place based on the value in the copied sheets range [B4] (Update_Data2). The first two elements work fine but the Update_Data2 keeps debugging due to objects etc. I posted before and got assistance but have got back from a few days off and need to get it operational. Detailed below is the code if anyone could help in resolving and/or streamlining. -------------------------------------------------------------------------------------------- Sub Teamexports() 'Team1 Range("C5").Select Selection.Copy Range("C3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Call Update_Data Exit Sub ''Team2, etc etc, -------------------------------------------------------------------------------------------- Sub Update_Data() Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayAlerts = False 'collate the name of the files Dim datestamp As String Dim Namefile As String Dim OpenName As String Dim Summary As String Summary = Range("TeamData") & " Performance Model WC " & Format(Range("WCDATA"), "dd_mm_yy") & ".xls" datestamp = Range("TeamData") & " Performance Model WC " & Format(Range("WCDATA"), "dd_mm_yy") 'open the workbook Namefile = Range("TeamData") OpenName = "\\ngclds06\manops\ams\Service\POM\" & Namefile & "\Performance Models\" & datestamp & ".xls" Workbooks.Open Filename:=OpenName, UpdateLinks:=False Call Update_Data2 End Sub -------------------------------------------------------------------------------------------- Sub Update_Data2() Dim Destsheet As String Set Destsheet = Sheets("Daily Team Performance").Range("B4") Dim rSource As Excel.Range Dim rDestination As Excel.Range Set rSource = ActiveSheet.Range("Daily Team Performance!B4:M103") Set rDestination = Sheets("Destsheet").Range("B4") rSource.Copy rDestination.Select Selection.PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False Range("A1").Select Application.CutCopyMode = False valKill: Set rSource = Nothing Set rDestination = Nothing Exit Sub End Sub --------------------------------------------------------------------------------------------
From: joel on 13 Apr 2010 09:51 try these changes Sub Teamexports() 'Team1 with Thisworkbook.Sheets("Teamexports") .Range("C3") = .Range("C5") end with Call Update_Data Exit Sub ''Team2, etc etc, -------------------------------------------------------------------------------------------- Sub Update_Data() Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayAlerts = False 'collate the name of the files Dim datestamp As String Dim Namefile As String Dim OpenName As String Dim Summary As String with thisworkbook Summary = .Range("TeamData") & " Performance Model WC " & _ Format(.Range("WCDATA"), "dd_mm_yy") & ".xls" datestamp = .Range("TeamData") & " Performance Model WC " & _ Format(.Range("WCDATA"), "dd_mm_yy") 'open the workbook Namefile = .Range("TeamData") OpenName = "\\ngclds06\manops\ams\Service\POM\" & _ Namefile& "\Performance Models\" & datestamp & ".xls" Set Teambk = Workbooks.Open( Filename:=OpenName, UpdateLinks:=False) Call Update_Data2(Teambk) end with End Sub -------------------------------------------------------------------------------------------- Sub Update_Data2(Teambk) Dim Destsheet As String with Thisworkbook Set Destsheet = .Sheets("Daily Team Performance").Range("B4") Dim rSource As Excel.Range Dim rDestination As Excel.Range Set rSource = Teambk.sheets("Daily Team Performance").Range("B4:M103") Set rDestination = .Sheets("Destsheet").Range("B4") rSource.Copy rDestination.PasteSpecial Paste:=xlPasteValues end with End Sub -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?u=229 View this thread: http://www.thecodecage.com/forumz/showthread.php?t=195120 http://www.thecodecage.com/forumz
From: JLGWhiz on 13 Apr 2010 10:51 some stuff that appeared to be superfluous was eliminated. Try this: Sub Update_Data2() Dim Destsheet As String Set Destsheet = Sheets("Daily Team Performance").Range("B4") Dim rSource As Excel.Range Set rSource = ActiveSheet.Range("Daily Team Performance!B4:M103") rSource.Copy Destsheet.PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False Range("A1").Select Application.CutCopyMode = False valKill: Set rSource = Nothing Set rDestination = Nothing Exit Sub End Sub "fishy" <fishy(a)discussions.microsoft.com> wrote in message news:4F32B237-3DB7-4182-B158-7C43DE1CB38E(a)microsoft.com... >I have an excel book that works through each of the teams based on a range >on > the control sheet (Teamexports), opens its respective team file based on > the > date and filepath (Update_Data) and then I want it to copy the data to the > named team tab already in place based on the value in the copied sheets > range > [B4] (Update_Data2). > > > The first two elements work fine but the Update_Data2 keeps debugging due > to > objects etc. > > I posted before and got assistance but have got back from a few days off > and > need to get it operational. > > Detailed below is the code if anyone could help in resolving and/or > streamlining. > > > -------------------------------------------------------------------------------------------- > > Sub Teamexports() > > 'Team1 > Range("C5").Select > Selection.Copy > Range("C3").Select > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, > SkipBlanks _ > :=False, Transpose:=False > > Call Update_Data > > Exit Sub > > ''Team2, etc etc, > > -------------------------------------------------------------------------------------------- > > Sub Update_Data() > > Application.Calculation = xlCalculationManual > Application.ScreenUpdating = False > Application.DisplayAlerts = False > > 'collate the name of the files > Dim datestamp As String > Dim Namefile As String > Dim OpenName As String > Dim Summary As String > > Summary = Range("TeamData") & " Performance Model WC " & > Format(Range("WCDATA"), "dd_mm_yy") & ".xls" > datestamp = Range("TeamData") & " Performance Model WC " & > Format(Range("WCDATA"), "dd_mm_yy") > 'open the workbook > > Namefile = Range("TeamData") > OpenName = "\\ngclds06\manops\ams\Service\POM\" & Namefile & "\Performance > Models\" & datestamp & ".xls" > > Workbooks.Open Filename:=OpenName, UpdateLinks:=False > > Call Update_Data2 > > End Sub > > -------------------------------------------------------------------------------------------- > > Sub Update_Data2() > > Dim Destsheet As String > Set Destsheet = Sheets("Daily Team Performance").Range("B4") > > Dim rSource As Excel.Range > Dim rDestination As Excel.Range > > Set rSource = ActiveSheet.Range("Daily Team Performance!B4:M103") > Set rDestination = Sheets("Destsheet").Range("B4") > > rSource.Copy > rDestination.Select > > Selection.PasteSpecial Paste:=xlPasteValues, _ > Operation:=xlNone, _ > SkipBlanks:=False, _ > Transpose:=False > > Range("A1").Select > > Application.CutCopyMode = False > > valKill: > Set rSource = Nothing > Set rDestination = Nothing > > Exit Sub > > End Sub > > -------------------------------------------------------------------------------------------- >
From: joel on 14 Apr 2010 06:45 I forgot there are some properties that don't work with Thisworkbook and do work with Activeworkbook. I didn't wnat to use Activeworkbook becuse when you open a workbook the focus chabges to the workbook that was opened which is the cuawe of your problems. I made some minor changes. see if this works Sub Teamexports() 'Team1 With ThisWorkbook.Sheets("Teamexports") .Range("C3") = .Range("C5") End With Call Update_Data Exit Sub End Sub Sub Update_Data() Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayAlerts = False 'collate the name of the files Dim datestamp As String Dim Namefile As String Dim OpenName As String Dim Summary As String With Workbooks(ThisWorkbook.Name) Summary = .Range("TeamData") & " Performance Model WC " & _ Format(.Range("WCDATA"), "dd_mm_yy") & ".xls" datestamp = .Range("TeamData") & " Performance Model WC " & _ Format(.Range("WCDATA"), "dd_mm_yy") 'open the workbook Namefile = .Range("TeamData") OpenName = "\\ngclds06\manops\ams\Service\POM\" & _ Namefile & "\Performance Models\" & datestamp & ".xls" Set Teambk = Workbooks.Open(Filename:=OpenName, UpdateLinks:=False) Call Update_Data2(Teambk) End With End Sub Sub Update_Data2(Teambk) With Workbooks(ThisWorkbook.Name) Dim rSource As Excel.Range Dim rDestination As Excel.Range Set rSource = Teambk.Sheets("Daily Team Performance").Range("B4:M103") Set rDestination = .Sheets("Destsheet").Range("B4") rSource.Copy rDestination.PasteSpecial Paste:=xlPasteValues End With End Sub -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?u=229 View this thread: http://www.thecodecage.com/forumz/showthread.php?t=195120 http://www.thecodecage.com/forumz
From: JLGWhiz on 14 Apr 2010 11:33
Forgot to change the Dim statement: Sub Update_Data2() Dim Destsheet As Range Set Destsheet = Sheets("Daily Team Performance").Range("B4") Dim rSource As Excel.Range Set rSource = ActiveSheet.Range("Daily Team Performance!B4:M103") rSource.Copy Destsheet.PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False Range("A1").Select Application.CutCopyMode = False valKill: Set rSource = Nothing Set Destsheet = Nothing Exit Sub End Sub "JLGWhiz" <JLGWhiz(a)cfl.rr.com> wrote in message news:ukXFXjx2KHA.4716(a)TK2MSFTNGP06.phx.gbl... > some stuff that appeared to be superfluous was eliminated. Try this: > > Sub Update_Data2() > > Dim Destsheet As String > Set Destsheet = Sheets("Daily Team Performance").Range("B4") > Dim rSource As Excel.Range > Set rSource = ActiveSheet.Range("Daily Team Performance!B4:M103") > rSource.Copy > Destsheet.PasteSpecial Paste:=xlPasteValues, _ > Operation:=xlNone, _ > SkipBlanks:=False, _ > Transpose:=False > > Range("A1").Select > > Application.CutCopyMode = False > > valKill: > Set rSource = Nothing > Set rDestination = Nothing > > Exit Sub > > End Sub > > > > > > "fishy" <fishy(a)discussions.microsoft.com> wrote in message > news:4F32B237-3DB7-4182-B158-7C43DE1CB38E(a)microsoft.com... >>I have an excel book that works through each of the teams based on a range >>on >> the control sheet (Teamexports), opens its respective team file based on >> the >> date and filepath (Update_Data) and then I want it to copy the data to >> the >> named team tab already in place based on the value in the copied sheets >> range >> [B4] (Update_Data2). >> >> >> The first two elements work fine but the Update_Data2 keeps debugging due >> to >> objects etc. >> >> I posted before and got assistance but have got back from a few days off >> and >> need to get it operational. >> >> Detailed below is the code if anyone could help in resolving and/or >> streamlining. >> >> >> -------------------------------------------------------------------------------------------- >> >> Sub Teamexports() >> >> 'Team1 >> Range("C5").Select >> Selection.Copy >> Range("C3").Select >> Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, >> SkipBlanks _ >> :=False, Transpose:=False >> >> Call Update_Data >> >> Exit Sub >> >> ''Team2, etc etc, >> >> -------------------------------------------------------------------------------------------- >> >> Sub Update_Data() >> >> Application.Calculation = xlCalculationManual >> Application.ScreenUpdating = False >> Application.DisplayAlerts = False >> >> 'collate the name of the files >> Dim datestamp As String >> Dim Namefile As String >> Dim OpenName As String >> Dim Summary As String >> >> Summary = Range("TeamData") & " Performance Model WC " & >> Format(Range("WCDATA"), "dd_mm_yy") & ".xls" >> datestamp = Range("TeamData") & " Performance Model WC " & >> Format(Range("WCDATA"), "dd_mm_yy") >> 'open the workbook >> >> Namefile = Range("TeamData") >> OpenName = "\\ngclds06\manops\ams\Service\POM\" & Namefile & >> "\Performance >> Models\" & datestamp & ".xls" >> >> Workbooks.Open Filename:=OpenName, UpdateLinks:=False >> >> Call Update_Data2 >> >> End Sub >> >> -------------------------------------------------------------------------------------------- >> >> Sub Update_Data2() >> >> Dim Destsheet As String >> Set Destsheet = Sheets("Daily Team Performance").Range("B4") >> >> Dim rSource As Excel.Range >> Dim rDestination As Excel.Range >> >> Set rSource = ActiveSheet.Range("Daily Team Performance!B4:M103") >> Set rDestination = Sheets("Destsheet").Range("B4") >> >> rSource.Copy >> rDestination.Select >> >> Selection.PasteSpecial Paste:=xlPasteValues, _ >> Operation:=xlNone, _ >> SkipBlanks:=False, _ >> Transpose:=False >> >> Range("A1").Select >> >> Application.CutCopyMode = False >> >> valKill: >> Set rSource = Nothing >> Set rDestination = Nothing >> >> Exit Sub >> >> End Sub >> >> -------------------------------------------------------------------------------------------- >> > > |