Combine rows from multiple different worksheets / workbooks into a Master workbook

[demetre]

good afternoon Everyone

Excel 2003

Issue: i am having trouble coding VBA to combine ranged rows from multiple different worksheets and workbooks into a single Master workbook(which contains all 8 different templates)

I have searched through the forums but i cannot find exactly what i need. I know it is very straight forwarded but it is evading me....

Process required:
Workbook contains 8 worksheet templates(not identical, but similar), which contain either numerical & financial or strings in cells (separate, not a mixture, either one or another) with a naming convention of every worksheet (8 alphanumeric characters) where the first 6 alphanumeric characters will indicate where the file has come from. The last two characters will indicate which of the 8 templates it is associated with. eg AA, BB, CC, DD, EE, FF, GG, HH (whole list btw).


Each worksheet is different, but only rows 2-6 will be required to be copied, there are multiple numbers of columns size(dynamic).


data: numerical & financial data (up to 12 digits) / strings (max 32 characts, but that is overkill)


8 Worksheet templates ==> 1 Master workbook, which will combine all this data

Master workbook would contain the following worksheets (AA, BB, CC, DD, EE, FF, GG, HH) using the the first 6 characters from the names of the worksheets, eg FG1XXXAA, where FG1 is a constant for each of these worksheet, XZX is who the worksheet(s) is from, and the suffix AA to HH as the type of template used and ready to be imported.


So in a nutshell i would like to setup a macro to

*copy rows 2-6 of every worksheet, but then

* copy using the naming convention from first 6 characters, and the last 2 characters to import into the respective master worksheet



I will be dealing with about 200-300 worksheets intially.



Any assistance would be very appreciated... thank you in advance....

[geekgirlau]

What have you done so far? Can you post a sanitised version of your workbook (use Manage Attachments)?

[demetre]

Sorry for the late response i have been very busy at work... Basically i have done some pseudo code mixed with code. Hopefully it is more undertsandable now... and advance apologies if the vba tags do not work properly... thanks very much for any assistance...

[vba]
//delcare function call
Function extract()

//declare variables
Dim sh As Worksheet
Dim DestSh As Worksheet

//
With Application
.Screenupdating = False
.EnableEvents = False
End With

//Set pathway to folder to import all workbooks for process, check if Master workbook exists, else exit with Error
calls function SetCurrentDirectoryA
check if Master workbook exists


//Using each worksheet's tab name, do import by case, using for loop
For each sh In Workbooks in this folder


//Case 1: if last 2 characters on worksheet name == AA,use Right (SheetName,2)
// then call copy rows 2-6 function
// paste special values into Master spreadsheet AA

//Case 2: if last 2 characters on worksheet name == BB, use Right (Sheetname,2)
// then call copy rows 2-6 function
// paste special values into Master spreadsheet BB

// these cases will involve up to 8 sheets in total
// AA / BB / CC / DD / EE / FF / GG / HH

//else exit with error
On Error GoTo 0
Application.DisplayAlerts = True

//Function call Copy rows 2-4 value not formatting, note cell values have been transposed from a column, so paste special value i think will be required
//Using the current active worksheet from each case above
ws.Range(2:2, 6:6).Copy

//Function call paste using PasteSpecial xlPasteValues

//Function call Set pathway directory, this function asks for a file, would be good to set it up just to locate folder
Private Declare Function SetCurrentDirectoryA _
Lib "kernel32" (ByVal lpPathName As String) As Long

Public Function GetOpenFilenameFrom(Optional sDirDefault As String) As Variant
'Author : Ken Puls
'Macro Purpose: To ask for a file at a specified directory

Dim sDirCurrent As String
Dim lError As Long

'Make note of the current directory
sDirCurrent = CurDir

If sDirDefault = vbNullString Then
'If optional arguement not supplied then
'assign current directory as default
sDirDefault = CurDir
Else
'If option arguement is supplied, test path to ensure
'that it exists. If not, assign current directory
If Len(Dir(sDirDefault, vbDirectory)) = 0 Then
sDirDefault = sDirCurrent
End If
End If

'Change the drive and directory
'*Drive change is unecessary if same, but takes as long to test
' as just changing it
If Not Left(sDirDefault, 2) = "\\" Then
'Not a network drive, so use ChDir
ChDrive Left(sDirDefault, 1)
ChDir (sDirDefault)
Else
'Network drive, so use API
lError = SetCurrentDirectoryA(sDirDefault)
If lError = 0 Then _
MsgBox "Sorry, I encountered an error accessing the network file path"
ChDir (sDirDefault)
End If

'Get the file's name & path, setting the filters to only display
'desired types. Help on the exact syntax can be found by looking
'up the GetOpenFilename method in the VBA help files
GetOpenFilenameFrom = Application.GetOpenFilename _
("Excel Files (*.xl*), *.xl*,All Files (*.*),*.*")

'Change the drive and directory back
If Not Left(sDirCurrent, 2) = "\\" Then
'Not a network drive, so use ChDrive
ChDrive Left(sDirCurrent, 1)
ChDir (sDirCurrent)
Else
'Network drive, so use API
lError = SetCurrentDirectoryA(sDirCurrent)
If lError = 0 Then _
MsgBox "Sorry, I encountered an error resetting the network file path"
ChDir (sDirCurrent)
End If

End Function
[/vba]