Need a loop script to copy from one 'data' workbook' to a template, make some edits,

[brfink2]

Dear all,

I’ve read a lot of posts on this forum – lot of smart people, but I need a very precise script:

I have about 15 ‘data’ sheets in separate work books. I was hoping to get help on a script that would:

Copy data from a techie looking data sheet to a ‘prettier’ template with descriptions, etc. The script should:
- copy all rows EXCEPT ROW 1 (there are over 100 columns and can be as many as 5,000 rows or more).
-paste the data into a new workbook in cell B14 (there are titles, headers, descriptions ect in the new workbook.
-The columns between the two workbooks don’t match up exactly. To make them match, the data that was pasted (From workbook 1) to the new workbook (workbook1_Collection Template) has to have the rows moved to the right.
-Beginning in column AY (ROW 14), grab all data , shift one cell to the right.
-Once complete, beginning in Column BM, move data two cells to the right (meaning any column including BM and after has moved a total of 3 spaces).
- Save the same name of workbook 1 (or 2, or 3, etc), but with “Collection Template” appended to the end.
-The script should loop until complete, opening, closing, and saving as needed for all files in the folder.
-If possible, the new workbook should not be .xlsm as that is what is being sent to the users.

If someone could get this to work, you would literally save hours and hours of my work in a period that is extremely critical in terms of timing! Note: I am a beginning and can recognize what a piece of code would do, but not quite smart enough to make edits, so it should be full code to be helpful.

[SamT]

Reply twice to this post.

How are the separate workbooks named.
Are there empty sheets in the separate workbooks?
How are the Data Sheets named.
Are all the workbooks in the same folder as the Template book?
Are there any other books in that folder?

Then:

Take 4 or 5 rows and the header row from your techie data sheet and put it them in a new workbook. non macro.

Put a pretty template sheet in the same workbook.

Using the 4 or 5 rows of data, complete the template sheet exactly as desired.

Upload that workbook for us to see by using the Go Advanced button and the Manage Attachments button below the Advanced editor window.

[brfink2]

Dear Sam,

Thanks for the follow up:
Go ahead and name them workbook 1 / workbook2 – I can update that part.

Are there empty sheets in the separate workbooks? Yes, but the data and the copy to should always be the first sheet , even “Sheet1”. The template sheet contains 3 additional tabs of data that should not be touched or edited.
How are the Data Sheets named. – No, just standard Excel names.
Are all the workbooks in the same folder as the Template book? Yes.
Are there any other books in that folder? No.


Also – unfortunately this data is sensitive and cannot be shared with the broad public. If you message me an email, I’d be willing to share it in that way (or I can PM message and attach) Is there a concern for how to code this? Essentially it is row 2 and below for all data templates (for 100+ columns) pasted into cells beginning B14.


All the best,

B

[SamT]

Dear Sam,

Thanks for the follow up:
Go ahead and name them workbook 1 / workbook2 – I can update that part.

Are there empty sheets in the separate workbooks? Yes, but the data and the copy to should always be the first sheet , even “Sheet1”. The template sheet contains 3 additional tabs of data that should not be touched or edited.
How are the Data Sheets named. – No, just standard Excel names.
Are all the workbooks in the same folder as the Template book? Yes.
Are there any other books in that folder? No.


Also – unfortunately this data is sensitive and cannot be shared with the broad public. If you message me an email, I’d be willing to share it in that way (or I can PM message and attach) Is there a concern for how to code this? Essentially it is row 2 and below for all data templates (for 100+ columns) pasted into cells beginning B14.


Please verify:

The Template sheet is named Sheet1, All data sheets are named Sheet1.
All workbooks in the Template Folder, except the Template book are Data books.
The Upper left Cell of the Data is "A2" of the data sheets.
The upper left cell in the Template Paste Range is "B14"
Data Columns "A:AW" go in Template Columns "B:AX"
Data Columns "AX:BJ" go in Template Columns "AZ:BL"
Data Columns "BK" to End go in Template columns "BN" to End.
After the template is completed for each data book it should be Saved As "Orginal Databook Name" & “Collection Template”
Save them where? Putting them back in the same folder can make for some big problems. I suggest a new folder in the existing folder, maybe named "Collections" or "Temp." Whatever you want to name it is fine.

[brfink2]

Please verify:
The Template sheet is named Sheet1, All data sheets are named Sheet1. CONFIRMED.
All workbooks in the Template Folder, except the Template book are Data books. CONFIRMED.
The Upper left Cell of the Data is "A2" of the data sheets. CONFIRMED. (In order to not copy header data).
The upper left cell in the Template Paste Range is "B14" CONFIRMED.
Data Columns "A:AW" go in Template Columns "B:AX" CONFIRMED.
Data Columns "AX:BJ" go in Template Columns "AZ:BL" CONFIRMED.
Data Columns "BK" to End go in Template columns "BN" to End.
After the template is completed for each data book it should be Saved As "Orginal Databook Name" & “Collection Template” CONFIRMED (with a space after Name of course :) )
"Collection Templates" are fine.

You are very though, I appreciate that. Please don't "bust your head" over making this perfect, whatever is fast and easy to code that accomplishes the goals will work for me. I can adapt as needed.

[SamT]

I have to leave now, but here are the ideas I have. You can play with them and I will have the complete code for you tomorrow.

The code will go in the Template workbook, Module1

Dim Tmpbk As New Workbook
For each databook in thisWorkbook.Path
For i = Template.Sheets.Count to 1
Copy Template.Sheets(i) to TmpBk
Next i
If Databook.Name <> TemplateBook.Name then Open Databook
Copy DataBook.Sheets("Sheet1").Range( First copy) to Tmpbk.Range(fistPaste)
Copy DataBook.Sheets("Sheet1").Range( secondcopy) to Tmpbk.Range(secondPaste)
Copy DataBook.Sheets("Sheet1").Range( thirdcopy) to Tmpbk.Range(thirdPaste)

Tmpbk.SaveAs Templatebook.Path & "\Collection Templates\" & DataBook.Name & " Collection Template"
Close Tmpbk
Close DataBook
Next Databook
Copy Ranges:
Range("A2:AW" & Cstr(LastRow))
Range("AX2:BJ" $ Cstr(LastRow))
Range("BK2:??" & CStr(LastRow))
Paste Ranges:
Range("B14")
Range("AX14")
Rnage("BN14")

[SamT]

You need to set some Constants herein.
Option Explicit

Private Sub InportDataSheets()

Dim TemplateBook As Workbook, TemplateName As Sring
Set TemplateBook = ThisWorkbook
TemplateName = TemplateBook.Name
Dim ThisPath As String, PthSep As String, Dot As String
ThisPath = ThisWorkbook.Path
PthSep = Application.PathSeparator
Dot = "."

Dim DataFileName As String
Dim NewName As String, Ext As String 'Newname and Ext are from the data file name

''''Declare copy and Paste Ranges. You need to set CR3
Dim LR As String 'Value of LastRow on DataBook.Sheet1
Dim CR1 As String, CR2 As String, CR3 As String 'Copy Ranges (-) LR
Dim PR1 As String, PR2 As String, PR3 As String 'PasteRanges
CR1 = "A2:AW": CR2 = "AX2:BJ": CR3 = "BK2:??" '?????????????????????
PR1 = "B14": PR2 = "AX14": PR3 = "BN14"

''''Set the folder to save the collection Teplates in. Edit as desired.
'Also Set the Suffix to add to the name when saved
Const ColDir As String = "Collection Templates"
Const NameSuffix As String = " Collection Template" 'Note Space

''''Simple Error checking
On Error GoTo ErrorHandler
'Check for Collection Templates Folder
If Dir(ThisPath & PthSep & ColDir, 16) = "" Then
MsgBox ColDir & "Folder Does not exist"
Exit Sub
End If

DataFileName = Dir(ThisPath & PthSep & "*.xl*")
''''Loop Thru all files in this folder.
Do While DataFileName <> ""
If DataFileName = TemplateName Then GoTo NextDataFile 'Don't do Template

'Set values of Variables NewName and Ext according to Data File
RightName DataFileName, NewName, Ext 'See Sub RightName below
'Concatenate NewName into FullName
NewName = ThisPath & PthSep & ColDir & PthSep & NewName & NameSuffix & Dot & Ext

Workbooks.Open Filename:=DataFileName, UpdateLinks:=0, ReadOnly:=True
LR = CStr(Workbooks(DataFileName).Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
Workbooks(DataFileName).Sheets(1).Range(CR1 & LR).Copy (TemplateBook.Sheets(1).Range(PR1))
Workbooks(DataFileName).Sheets(1).Range(CR2 & LR).Copy (TemplateBook.Sheets(1).Range(PR2))
Workbooks(DataFileName).Sheets(1).Range(CR3 & LR).Copy (TemplateBook.Sheets(1).Range(PR3))
TemplateBook.SaveCopyAs NewName
'Clear the Template book below row 13
TemplateBook.Rows(14, Rows.Count).ClearContents
Workbooks(DataFileName).Close
NextDataFile:
DataFileName = Dir
Loop
Exit Sub

ErrorHandler:
MsgBox "Oops! An Error occured! Sorry."
Error = 0 'Clear Error
End Sub

Private Sub RightName(DataName As String, _
ByRef NewName As String, _
ByRef Ext As String)
'DataName is the name of a data file. As Written, Function will _
Return Ext of Datafile. Uncomment (below) to use Extension _
of Template File.

Dim ThisNameParts

''''Initialize outside variables
NewName = ""
Ext = ""

''''Generate the name without an extension
ThisNameParts = Split(DataName, ".")
'Since multiple dots are allowed in file names.
For i = LBound(ThisNameParts) To UBound(ThisNameParts) - 1
NewName = NewName & ThisNameParts(i)
'Add any but the last dot to NewName.
If i > 0 And i < UBound(ThisNameParts) - 1 Then NewName = NewName & "."
Next i

''''Get the Extension
'Uncomment next line to use Template Extension.
'ThisNameParts = Split(ThisWorkbook.Name, ".")
Ext = ThisNameParts(UBound(ThisNameParts))
End Sub

[brfink2]

Hi,

I have been going through this.

I did run into an error.

String was spelled incorrectly "Sring". Easy Fix :)

I did run into a variable not defined error on the second function for "i" not being defined.

It 'stopped' right after Sub RightName(DataName As String, _
ByRef NewName As String, _
ByRef Ext As String)

[SamT]

Dim ThisNameParts
Dim i As Long