Davorenko
01-13-2016, 06:19 AM
Hi guys,
The code I've been using doesn't give me the results I want.
Basically, I want it to copy-paste the two selections (which contains functions and graphs) to another Excel file (paste values and graphs). When it sends the data to the other file, I want it to create a new sheet based on a value in a cell.
Sub TransferData()
Dim x As Workbook
Dim y As Workbook
Dim ShtName As String
'## Open both workbooks first:
Set x = Workbooks.Open("C:\Davorito\Report generator.xlsm")
Set y = Workbooks.Open("C:\Davorito\Reports database.xlsm")
'name that will be used for a new sheet in the reports database
ShtName = Sheet1.Cells(1, 10).value
'checks if there are sheets with same name
If Not WksExists(ShtName) Then Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = ShtName
'Now, copy what you want from x:
x.Sheets("Template").Range("A2:AC953").Copy
'Now, paste to y worksheet:
y.Sheets("sheetname").Range("A1").PasteSpecial
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, transpose:=False
'Now, copy what you want from x:
x.Sheets("Template").Range("A1021:AL1085").Copy
'Now, paste to y worksheet:
y.Sheets("sheetname").Range("A1").PasteSpecial
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, transpose:=False
'Close x:
x.Close
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function
The code I've been using doesn't give me the results I want.
Basically, I want it to copy-paste the two selections (which contains functions and graphs) to another Excel file (paste values and graphs). When it sends the data to the other file, I want it to create a new sheet based on a value in a cell.
Sub TransferData()
Dim x As Workbook
Dim y As Workbook
Dim ShtName As String
'## Open both workbooks first:
Set x = Workbooks.Open("C:\Davorito\Report generator.xlsm")
Set y = Workbooks.Open("C:\Davorito\Reports database.xlsm")
'name that will be used for a new sheet in the reports database
ShtName = Sheet1.Cells(1, 10).value
'checks if there are sheets with same name
If Not WksExists(ShtName) Then Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = ShtName
'Now, copy what you want from x:
x.Sheets("Template").Range("A2:AC953").Copy
'Now, paste to y worksheet:
y.Sheets("sheetname").Range("A1").PasteSpecial
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, transpose:=False
'Now, copy what you want from x:
x.Sheets("Template").Range("A1021:AL1085").Copy
'Now, paste to y worksheet:
y.Sheets("sheetname").Range("A1").PasteSpecial
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, transpose:=False
'Close x:
x.Close
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function