OaklandJim
Well-known Member
- Joined
- Nov 29, 2018
- Messages
- 855
- Office Version
- 365
- Platform
- Windows
I am trying to help another list member. He wants data in a specific column in a source worksheet in a source workbook copied to a range in a target worksheet in a new workbook. I am close but when I try to PasteSpecial values into the worksheet in the new workbook I get an error message stating that PasteSpecial Method of Range Class failed.
I know that I am missing something basic here?! Thanks for the assistance.
The workbook is HERE.
Here is code.
I know that I am missing something basic here?! Thanks for the assistance.
The workbook is HERE.
Here is code.
VBA Code:
Sub MakeTemplateFiles()
Dim rCell As Range
Dim rColHeaders As Range
Dim iLoopsMade As Long
Dim iDataColFound As Long
' Unknown # of headers are in row 1 starting in column A.
Set rColHeaders = ThisWorkbook.Worksheets("Table").Range("1:1")
' Loop to process all columns whose header is like "SN*"
Do
iLoopsMade = iLoopsMade + 1
Set rCell = rColHeaders.Cells(1, iLoopsMade)
If rCell.Value Like "SN*" _
Then
iDataColFound = iDataColFound + 1
Call CreateTemplateFile(iDataColFound, rCell)
End If
ThisWorkbook.Worksheets("Table").Activate
Loop Until rCell = ""
End Sub
VBA Code:
Sub CreateTemplateFile(piFileNum As Long, prDataAnchorCell As Range)
' Set to new workbook created.
Dim wbTemplate As Workbook
' Set to target worksheet in the new workbook.
Dim wsTarget As Worksheet
' Find last occupied cell in the data column.
Dim iLastCellInColData As Long
' Get count of data items in the columnar range.
Dim iDataItemsInColumn As Long
' Path and filename of new workbook.
Dim sPath As String
' Set location and name of the new target workbook created below.
sPath = ThisWorkbook.Path & "\" & "Template" & piFileNum & ".xlsx"
' Kill existing file if it exists. This chokes if the file is open.
If Dir(sPath) <> "" _
Then
On Error Resume Next
Kill sPath
On Error GoTo 0
End If
' Find last occupied row in the data column.
iLastCellInColData = prDataAnchorCell.Offset(10000).End(xlUp).Row
' Get count of cells to transfer.
iDataItemsInColumn = iLastCellInColData - prDataAnchorCell.Row
' Copy data for the current data column.
prDataAnchorCell.Resize(iDataItemsInColumn + 1).Copy
' Create the new target workbook.
Set wbTemplate = Workbooks.Add
With ActiveWorkbook
' SaveAs the ActiveWorkbook
.SaveAs Filename:=sPath
' Target worksheet is sheet 1 in the ActiveWorkbook
Set wsTarget = .Worksheets(1)
With wsTarget
' Activate the target (first) worksheet in the ActiveWorkbook.
.Activate
' Name the target worksheet in the AciveWorkbook.
.Name = "Template" & piFileNum
' 1st column header in target worksheet (in the target workbook) is always the same.
.Cells(1) = "a/a"
' Header text for data column.
.Cells(1, 2) = "SN" & piFileNum
' Paste values from source worksheet in source workbook into target worksheet in the
' ActiveWorkbook (i.e., the target workbook). Always paste into column 2.
.Cells(2, 2).PasteSpecial Paste:=xlPasteValues '<= DOES NOT WORK
End With
Application.CutCopyMode = False
Application.DisplayAlerts = False
.Save
.Close
End With
End Sub