Copy specific rows from excel based on a specific cell value

Question

I have multiple worksheets in a excel book and each of these worksheet contains module wise data. I want to copy all the module data from each worksheet and paste it in a new excel book. How can this be done using VBScript?

All sheets looks something like this in rawData.xls

 A        B        C 
Module1  999     asda
Module2  22      asda
Module1  33      asda
Module7  44      asda
Module3  55      asda
Module2  66      asda
Module5  77      asda

I need to iterate all the sheets in rawData.xls, copy all rows containing "Module1" and paste it to result.xls, and repeat for Module2, Module3, ...

Is there a way to make this kind of an automated one using VB Script?

Any help is appreciated. Thanks in advance

My Code:

Sub copy() 
    Set objRawData = objExcel.Workbooks.Open("rawData.xls") 
    Set objPasteData = objExcel.Workbooks.Open("result.xls") 
    StartRow = 1 RowNum = 2 
    Do Until IsEmpty(objRawData.WorkSheets("Sheet1").Range("C" & RowNum)) 
      If objRawData.WorkSheets("Sheet1").Range("C" & RowNum) = "module1" Then
        StartRow = StartRow + 1 
        objPasteData.WorkSheets("Final").Rows(StartRow).Value = _ 
                objRawData.WorkSheets("Sheet1").Rows(RowNum).Value 
      End If 
      RowNum = RowNum + 1 
    Loop 
End Sub

Answer 1

@Peter L, @Kim Gysen & @Ekkehard.Horner, Thanks guys for all the codes that you guys gave. But the code is way above my head. How ever i did solve this issue. I just copied all the data from all the sheets into the new excel book and just sorted the entire data based on Modules. So i was able to get the solution.

Sub CopyRawData()
countSheet = RawData.Sheets.Count
For i = 1 to countSheet     
    RawData.Activate
    name = RawData.Sheets(i).Name

    RawData.WorkSheets(name).Select
    RawData.Worksheets(name).Range("A2").Select

    objExcel.ActiveSheet.UsedRange.Select
    usedRowCount1 = objExcel.Selection.Rows.Count
    objExcel.Range("A2:J" & usedRowCount1).Copy

    RawData.WorkSheets(name).Select
    RowCount = objExcel.Selection.Rows.Count
    RawData.Worksheets(name).Range("F2").Select

    FinalReport.Activate
    FinalReport.WorkSheets("Results").Select
    objExcel.ActiveSheet.UsedRange.Select
    usedRowCount2= objExcel.Selection.Rows.Count

    FinalReport.Worksheets("Results").Range("A"& usedRowCount2 + 1 ).PasteSpecial Paste =xlValues

Next
FinalReport.Save                        

Sub CopyData()
    Const xlAscending = 1
    Const xlDescending = 2
    Const xlYes = 1
    Set objRange = FinalReport.Worksheets("Results").UsedRange
    Set objRange2 = objExcel.Range("C2")
    objRange.Sort objRange2, xlAscending, , , , , , xlYes
End Sub

Answer 2

I gave it another approach aside from SQL and sorts (already provided before).
I tested this code and it works.

The general idea behind this code:

1. Class module "clsSheet" contains all information per sheet, ie. column headers A, B, C, but also the used range, the array in which this range is loaded and the maximum row / col.
2. These self created data objects are loaded into a collection, after which the next part of the code will execute all code in memory (fast).
3. A dictionary is created and will contain the "module name" (ie. module1,2,3 etc...) as key, and a clsModule object as value. When a key (thus module name) does not exist yet, a new item will be added.
4. The clsModule class keeps the information on each modulename, ie. columns A, B and C information. The information is stored in the form of arrays.
5. When all information is stored in the dictionary, it is only a matter of translating the dictionary content back to a form that is preferred. In this case, I chose to give to each sheet the name of dictionary keys and load the data to their corresponding sheets.

This code includes:

• Dynamically finds headers with names "A", "B" and "C", which reduces risk for bugs;
• Fast execution;
• Creates a new workbook and writes the values for each "module" to a different sheet.
• These classes are re-usable in other situations with minimum modification needed.

The major benefit of this approach is flexibility. Since you load all data in a framework, you can virtually perform any actions afterwards by setting the classes and calling their properties.

Sub GetModules()


Dim cSheet                      As clsSheet
Dim cModule                     As clsModule
Dim oSheet                      As Excel.Worksheet
Dim oColl_Sheets                As Collection
Dim oDict                       As Object
Dim vTemp_Array_A               As Variant
Dim vTemp_Array_B               As Variant
Dim vTemp_Array_C               As Variant

Dim lCol_A                      As Long
Dim lCol_B                      As Long
Dim lCol_C                      As Long
Dim lMax_Row                    As Long
Dim lMax_Col                    As Long
Dim oRange                      As Range
Dim oRange_A                    As Range
Dim oRange_B                    As Range
Dim oRange_C                    As Range
Dim vArray                      As Variant

Dim lCnt                        As Long
Dim lCnt_Modules                As Long

Dim oBook                       As Excel.Workbook
Dim oSheet_Results              As Excel.Worksheet


Set oColl_Sheets = New Collection
Set oDict = CreateObject("Scripting.Dictionary")

'Get number of columns, rows and headers A, B, C dynamically
'This is useful in case columns are inserted
For Each oSheet In ThisWorkbook.Sheets

    Set cSheet = New clsSheet
    Set cSheet = cSheet.get_Sheet_Data(cSheet, oSheet)

    oColl_Sheets.Add cSheet

Next oSheet

'At this point, your entire sheet data structure is already contained in the collection oColl_Sheets

Set cSheet = Nothing

'Loop through the sheet objects and retrieve the values into modules
For Each cSheet In oColl_Sheets

    'Now you load back all data from the sheet and perform loops in memory through the arrays
    lCol_A = cSheet.fA_Col
    lCol_B = cSheet.fB_Col
    lCol_C = cSheet.fC_Col
    lMax_Row = cSheet.fMax_Row
    lMax_Col = cSheet.fMax_Col
    Set oRange = cSheet.fRange
    vArray = cSheet.fArray

    For lCnt = 1 To lMax_Row - 1

        'Check if the module already exists
        If Not oDict.Exists(vArray(1 + lCnt, 1)) Then  '+1 due to header
            lCnt_Modules = lCnt_Modules + 1
            Set cModule = New clsModule

            'Add to dictionary when new module (thus key) is new
            Set cModule = cModule.Add_To_Array_A(cModule, lCol_A, vArray(1 + lCnt, lCol_A), True)
            Set cModule = cModule.Add_To_Array_B(cModule, lCol_B, vArray(1 + lCnt, lCol_B), True)
            Set cModule = cModule.Add_To_Array_C(cModule, lCol_C, vArray(1 + lCnt, lCol_C), True)

            oDict.Add vArray(1 + lCnt, 1), cModule

        Else

            Set cModule = oDict(vArray(1 + lCnt, 1))

            'Replace when module (thus key) already exists
            Set cModule = cModule.Add_To_Array_A(cModule, lCol_A, vArray(1 + lCnt, lCol_A), False)
            Set cModule = cModule.Add_To_Array_B(cModule, lCol_A, vArray(1 + lCnt, lCol_B), False)
            Set cModule = cModule.Add_To_Array_C(cModule, lCol_A, vArray(1 + lCnt, lCol_C), False)

            Set oDict(vArray(1 + lCnt, 1)) = cModule

        End If

    Next lCnt

Next cSheet

'Now you have all the data available in your dictionary: per module (key), there is an array with the data you need.
'The only thing you have to do is open a new workbook and paste the data there.
'Below an example how you can paste the results per worksheet

Set oBook = Workbooks.Add
Set oSheet_Results = oBook.Sheets(1)

lCnt = 0
For lCnt = 0 To oDict.Count - 1

    'Fill in values from dictionary
    oBook.Sheets.Add().Name = oDict.Keys()(lCnt)
    ReDim vTemp_Array_A(1 To UBound(oDict.Items()(lCnt).fA_Arr))
    ReDim vTemp_Array_B(1 To UBound(oDict.Items()(lCnt).fB_Arr))
    ReDim vTemp_Array_C(1 To UBound(oDict.Items()(lCnt).fC_Arr))
    oBook.Sheets(oDict.Keys()(lCnt)).Range("A1").Value = "A"
    oBook.Sheets(oDict.Keys()(lCnt)).Range("B1").Value = "B"
    oBook.Sheets(oDict.Keys()(lCnt)).Range("C1").Value = "C"

    vTemp_Array_A = oDict.Items()(lCnt).fA_Arr
    vTemp_Array_B = oDict.Items()(lCnt).fB_Arr
    vTemp_Array_C = oDict.Items()(lCnt).fC_Arr
    Set oRange_A = oBook.Sheets(oDict.Keys()(lCnt)).Range(Cells(2, 1), Cells(1 + UBound(vTemp_Array_A), 1))
    Set oRange_B = oBook.Sheets(oDict.Keys()(lCnt)).Range(Cells(2, 2), Cells(1 + UBound(vTemp_Array_B), 2))
    Set oRange_C = oBook.Sheets(oDict.Keys()(lCnt)).Range(Cells(2, 3), Cells(1 + UBound(vTemp_Array_C), 3))
    oRange_A = Application.Transpose(vTemp_Array_A)
    oRange_B = Application.Transpose(vTemp_Array_B)
    oRange_C = Application.Transpose(vTemp_Array_C)

Next lCnt

Set oColl_Sheets = Nothing
Set oRange = Nothing
Set oDict = Nothing

End Sub

Class module called "clsModule"

Option Explicit

Private pModule_Nr              As Long
Private pA_Arr                  As Variant
Private pB_Arr                  As Variant
Private pC_Arr                  As Variant

Public Function Add_To_Array_A(cModule As clsModule, lCol As Long, vValue As Variant, bNew As Boolean) As clsModule

Dim vArray As Variant

vArray = cModule.fA_Arr

If bNew Then
    ReDim vArray(1 To 1)
    vArray(1) = vValue
Else
    ReDim Preserve vArray(1 To UBound(vArray) + 1)
    vArray(UBound(vArray)) = vValue
End If

cModule.fA_Arr = vArray

Set Add_To_Array_A = cModule

End Function

Public Function Add_To_Array_B(cModule As clsModule, lCol As Long, vValue As Variant, bNew As Boolean) As clsModule

Dim vArray As Variant

vArray = cModule.fB_Arr

If bNew Then
    ReDim vArray(1 To 1)
    vArray(1) = vValue
Else
    ReDim Preserve vArray(1 To UBound(vArray) + 1)
    vArray(UBound(vArray)) = vValue
End If

cModule.fB_Arr = vArray

Set Add_To_Array_B = cModule

End Function

Public Function Add_To_Array_C(cModule As clsModule, lCol As Long, vValue As Variant, bNew As Boolean) As clsModule

Dim vArray As Variant

vArray = cModule.fC_Arr

If bNew Then
    ReDim vArray(1 To 1)
    vArray(1) = vValue
Else
    ReDim Preserve vArray(1 To UBound(vArray) + 1)
    vArray(UBound(vArray)) = vValue
End If

cModule.fC_Arr = vArray

Set Add_To_Array_C = cModule

End Function


Property Get fModule_Nr() As Long
    fModule_Nr = pModule_Nr
End Property

Property Let fModule_Nr(lModule_Nr As Long)
    pModule_Nr = lModule_Nr
End Property

Property Get fA_Arr() As Variant
    fA_Arr = pA_Arr
End Property

Property Let fA_Arr(vA_Arr As Variant)
    pA_Arr = vA_Arr
End Property

Property Get fB_Arr() As Variant
    fB_Arr = pB_Arr
End Property

Property Let fB_Arr(vB_Arr As Variant)
    pB_Arr = vB_Arr
End Property

Property Get fC_Arr() As Variant
    fC_Arr = pC_Arr
End Property

Property Let fC_Arr(vC_Arr As Variant)
    pC_Arr = vC_Arr
End Property

Class module called "clsSheet"

Option Explicit
Private pMax_Col                As Long
Private pMax_Row                As Long
Private pArray                  As Variant
Private pRange                  As Range
Private pA_Col                  As Long
Private pB_Col                  As Long
Private pC_Col                  As Long

Public Function get_Sheet_Data(cSheet As clsSheet, oSheet As Excel.Worksheet) As clsSheet

Dim oUsed_Range         As Range
Dim lLast_Col           As Long
Dim lLast_Row           As Long
Dim iCnt                As Integer
Dim vArray              As Variant
Dim lNr_Rows            As Long
Dim lNr_Cols            As Long

Dim lCnt                As Long


With oSheet
    lLast_Row = .Cells(.Rows.Count, "A").End(xlUp).Row
    lLast_Col = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With

oSheet.Activate
Set oUsed_Range = oSheet.Range(Cells(1, 1), Cells(lLast_Row, lLast_Col))
cSheet.fRange = oUsed_Range
lNr_Rows = oUsed_Range.Rows.Count
cSheet.fMax_Row = lNr_Rows
lNr_Cols = oUsed_Range.Columns.Count
cSheet.fMax_Col = lNr_Cols
ReDim vArray(1 To lNr_Rows, 1 To lNr_Cols)
vArray = oUsed_Range
cSheet.fArray = vArray

For lCnt = 1 To lNr_Cols
    Select Case vArray(1, lCnt)

        Case "A"
            cSheet.fA_Col = lCnt
        Case "B"
            cSheet.fB_Col = lCnt
        Case "C"
            cSheet.fC_Col = lCnt

    End Select
Next lCnt

Set get_Sheet_Data = cSheet

End Function

Property Get fMax_Col() As Long
    fMax_Col = pMax_Col
End Property

Property Let fMax_Col(lMax_Col As Long)
    pMax_Col = lMax_Col
End Property

Property Get fMax_Row() As Long
    fMax_Row = pMax_Row
End Property

Property Let fMax_Row(lMax_Row As Long)
    pMax_Row = lMax_Row
End Property

Property Get fRange() As Range
    Set fRange = pRange
End Property

Property Let fRange(oRange As Range)
    Set pRange = oRange
End Property

Property Get fArray() As Variant
    fArray = pArray
End Property

Property Let fArray(vArray As Variant)
    pArray = vArray
End Property

Property Get fA_Col() As Long
    fA_Col = pA_Col
End Property

Property Let fA_Col(lA_Col As Long)
    pA_Col = lA_Col
End Property

Property Get fB_Col() As Long
    fB_Col = pB_Col
End Property

Property Let fB_Col(lB_Col As Long)
    pB_Col = lB_Col
End Property

Property Get fC_Col() As Long
    fC_Col = pC_Col
End Property

Property Let fC_Col(lC_Col As Long)
    pC_Col = lC_Col
End Property

Answer 3

Here is my approach: very straightforward and violates many programming principles, e.g. "avoid copy/paste usage", but from learning perspective it seems to be very easy to understand, and about 80% of code were generated using MacroRecorder. Here it is:

Sub DataToBook()

Dim CurDir As String
Dim ResultBook As String
Dim ResultRow As Long
Dim WS As Worksheet

Application.ScreenUpdating = False

CurDir = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "", vbTextCompare)
ResultBook = "Results.xlsx"
ResultRow = 1

Workbooks.Add
ActiveWorkbook.SaveAs Filename:=CurDir & ResultBook, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False

For Each WS In ThisWorkbook.Worksheets

    ThisWorkbook.Activate
    WS.Select
    WS.Range("A1").Select
    WS.Rows("1:" & Selection.CurrentRegion.Rows.Count).Copy
    Workbooks(ResultBook).Sheets(1).Activate
    Workbooks(ResultBook).Sheets(1).Range("A1").Select
    If Selection.CurrentRegion.Rows.Count > 1 Then ResultRow = Selection.CurrentRegion.Rows.Count + 1
    Workbooks(ResultBook).Sheets(1).Cells(ResultRow, 1).Insert Shift:=xlDown

Next WS

Application.CutCopyMode = False

Workbooks(ResultBook).Sheets(1).Range("A1").Select
Workbooks(ResultBook).Sheets(1).Sort.SortFields.Clear
'
' Comment each of 3 lines below where sorting is not needed.
'
Workbooks(ResultBook).Sheets(1).Sort.SortFields.Add Key:=Range("A1:A" & Selection.CurrentRegion.Rows.Count), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Workbooks(ResultBook).Sheets(1).Sort.SortFields.Add Key:=Range("B1:B" & Selection.CurrentRegion.Rows.Count), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Workbooks(ResultBook).Sheets(1).Sort.SortFields.Add Key:=Range("C1:C" & Selection.CurrentRegion.Rows.Count), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

With Workbooks(ResultBook).Sheets(1).Sort
    .SetRange Selection.CurrentRegion
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

ThisWorkbook.Activate
ThisWorkbook.Sheets(1).Select
ActiveSheet.Range("A1").Select
Workbooks(ResultBook).Close SaveChanges:=True

Application.ScreenUpdating = True

End Sub

As a result, new workbook Results.xlsx will be created in the same folder as source. Key points of my approach:

1. Data is collected to new workbook using copy/paste of data regions of every original book sheet.
2. Key items are grouped using resulting array sort: my code uses all 3 columns for sorting, but to keep original order from source workbook one should just comment respective lines of code to disable sort settings.
3. Number of data keys and source book sheets is "unlimited" with such approach.

Sample file is shared as well: https://www.dropbox.com/s/ual33s5me1gzhus/DataToBook.xlsm

Hope that will be helpful somehow, at least in terms of learning of basic VBA coding.

Answer 4

Instead of letting the popular 'What have you tried?' coerce you into writing code without a plan, think about (and ask for) the know how/know to/methods/tools necessary for selecting specific rows of sheets/tables into new sheets/tables.

"select" implies SQL and while Excel is not a database mangement system, you can use an .XLS as a database: with a little help from ADO.

So my plan would be:

(1) Open an ADODB.Connection to your source .XLS

(2) Get a list of all sheets/tables to process

(3) Use (2) to generate a statement like

SELECT [A] FROM [Tbl1] UNION SELECT [A] FROM [Tbl2] UNION SELECT [A] FROM [Tbl3] ORDER BY [A]

(4) Execute (3) and loop over the resultset

(5) For Each Module1 ... ModuleLast

(5a) To create the new sheet/table for Module M in your destination .XLS, execute a statement like

SELECT * INTO [TblModuleM]  IN "path\to\your\dst.xls" "Excel 8.0;" FROM [Tbl1] WHERE [A] = 'ModuleM'

(5b) For Each Tbl2 ... TblLast append the ModuleM rows using statements like

INSERT INTO [TblModuleM]  IN "path\to\your\dst.xls" "Excel 8.0;" SELECT * FROM [TblT] WHERE [A] = 'ModuleM'

Demo code to give you some confidence in the plan and some keywords to look up:

  Const csSFSpec   = "..\data\14515369\src.xls"
  Const csDFSpec   = "..\data\14515369\dst.xls"
  Const csTables   = "[Tbl1] [Tbl2] [Tbl3]"

  Dim aTblNs  : aTblNs   = Split(csTables)
  Dim oFS     : Set oFS = CreateObject("Scripting.FileSystemObject")
  Dim sSFSpec : sSFSpec = oFS.GetAbsolutePathName(csSFSpec)
  Dim sDFSpec : sDFSpec = oFS.GetAbsolutePathName(csDFSpec)
  If oFS.FileExists(sDFSpec) Then oFS.DeleteFile sDFSpec

  Dim oDbS    : Set oDbS = CreateObJect("ADODB.Connection")
  Dim sCS     : sCS      = Join(Array( _
    "Provider=Microsoft.Jet.OLEDB.4.0", "Data Source=" & sSFSpec, _
    "Extended Properties=""Excel 8.0;HDR=True;IMEX=0;Readonly=False""" _
  ),";")
  WScript.Echo "Connectionstring:"
  WScript.Echo sCS
  oDbS.Open sCS
  Dim sInExt  : sInExt   = " IN """ & sDFSpec & """ ""Excel 8.0;"""

  Dim sSelI : sSelI = "SELECT * INTO [Tbl@Mod] " & sInExt & " FROM @Tbl WHERE [A] = '@Mod'"
  Dim sInsI : sInsI = "INSERT INTO [Tbl@Mod] " & sInExt & " SELECT * FROM @Tbl WHERE [A] = '@Mod'"
  WScript.Echo sSelI
  WScript.Echo sInsI

  Dim sMods : sMods = "SELECT [A] FROM " & aTblNs(0)
  Dim i
  For i = 1 TO UBound(aTblNs)
      sMods = sMods & " UNION SELECT [A] FROM " & aTblNs(i)
  Next
  sMods = sMods & " ORDER BY [A]"
  WScript.Echo sMods

  Dim oRS  : Set oRS = oDbS.Execute(sMods)
  Dim sSQL
  Do Until oRS.EOF
     WScript.Echo "Processing", oRS("A"), "..."
     sSQL = Replace(Replace(sSelI, "@Mod", oRS("A")), "@Tbl", aTblNs(0))
     WScript.Echo "Create & fill new table for", oRS("A")
     WScript.Echo sSQL
     oDbS.Execute sSQL
     For i = 1 To UBound(aTblNs)
         sSQL = Replace(Replace(sInsI, "@Mod", oRS("A")), "@Tbl", aTblNs(i))
         WScript.Echo "Appending for", oRS("A"), "from", aTblNs(i)
         WScript.Echo sSQL
         oDbS.Execute sSQL
     Next
     oRS.MoveNext
  Loop
  oRS.Close
  oDbS.Close

output:

Connectionstring:
Provider=Microsoft.Jet.OLEDB.4.0;Data Source=somewheresrc.xls;Extended
 Properties="Excel 8.0;HDR=True;IMEX=0;Readonly=False"
SELECT * INTO [Tbl@Mod]  IN "somewheredst.xls" "Excel 8.0;" FROM @Tbl
WHERE [A] = '@Mod'
INSERT INTO [Tbl@Mod]  IN "somewheredst.xls" "Excel 8.0;" SELECT * FRO
M @Tbl WHERE [A] = '@Mod'
SELECT [A] FROM [Tbl1] UNION SELECT [A] FROM [Tbl2] UNION SELECT [A] FROM [Tbl3] ORDER BY [A]
Processing Module1 ...
Create & fill new table for Module1
SELECT * INTO [TblModule1]  IN "somewheredst.xls" "Excel 8.0;" FROM [T
bl1] WHERE [A] = 'Module1'
Appending for Module1 from [Tbl2]
INSERT INTO [TblModule1]  IN "somewheredst.xls" "Excel 8.0;" SELECT *
FROM [Tbl2] WHERE [A] = 'Module1'
Appending for Module1 from [Tbl3]
INSERT INTO [TblModule1]  IN "somewheredst.xls" "Excel 8.0;" SELECT *
FROM [Tbl3] WHERE [A] = 'Module1'
Processing Module2 ...
Create & fill new table for Module2
SELECT * INTO [TblModule2]  IN "somewheredst.xls" "Excel 8.0;" FROM [T
bl1] WHERE [A] = 'Module2'
Appending for Module2 from [Tbl2]
INSERT INTO [TblModule2]  IN "somewheredst.xls" "Excel 8.0;" SELECT *
FROM [Tbl2] WHERE [A] = 'Module2'
Appending for Module2 from [Tbl3]
INSERT INTO [TblModule2]  IN "somewheredst.xls" "Excel 8.0;" SELECT *
FROM [Tbl3] WHERE [A] = 'Module2'
Processing Module3 ...
Create & fill new table for Module3
SELECT * INTO [TblModule3]  IN "somewheredst.xls" "Excel 8.0;" FROM [T
bl1] WHERE [A] = 'Module3'
Appending for Module3 from [Tbl2]
INSERT INTO [TblModule3]  IN "somewheredst.xls" "Excel 8.0;" SELECT *
FROM [Tbl2] WHERE [A] = 'Module3'
Appending for Module3 from [Tbl3]
INSERT INTO [TblModule3]  IN "somewheredst.xls" "Excel 8.0;" SELECT *
FROM [Tbl3] WHERE [A] = 'Module3'
Processing Module4 ...
Create & fill new table for Module4
SELECT * INTO [TblModule4]  IN "somewheredst.xls" "Excel 8.0;" FROM [T
bl1] WHERE [A] = 'Module4'
Appending for Module4 from [Tbl2]
INSERT INTO [TblModule4]  IN "somewheredst.xls" "Excel 8.0;" SELECT *
FROM [Tbl2] WHERE [A] = 'Module4'
Appending for Module4 from [Tbl3]
INSERT INTO [TblModule4]  IN "somewheredst.xls" "Excel 8.0;" SELECT *
FROM [Tbl3] WHERE [A] = 'Module4'