VBA question on Merging data from two sheets

[Queryman]

I have a macro that works well in merging data from similarly formatted files (each with different data) in a folder. It extracts data from a certain sheet from each file and then merges them into one excel worksheet. I need a change made to this macro and not sure how to do this.

Currently the macro copies all the data from sheet2 in every file, there are only 500 rows of data at the most on every file, I now need it to copy the data in sheet3 only if the value in column C in that sheet is "Speaker Programs" and also I need the value in column A of the corresponding row in sheet2 copied. Following is my current macro

Sub MergeSheets()
Dim SrcBook As Workbook
Dim fso As Object, f As Object, ff As Object, f1 As Object
Dim wkSht As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo Bye
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.Getfolder("C:\TEMP\4-11\")
Set ff = f.Files
For Each f1 In ff
Set SrcBook = Workbooks.Open(f1)
Sheets(2).Select
Range("A2:J" & Range("b500").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
With Selection
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
SrcBook.Close
End With
Next
Bye:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Any assistance will be highly appreciated.
Thanks,




Michael

 

[SkipVought]

Queryman,

What's in a name???

Well, could this be a QUERY instead of open/copy/paste/close?

The key question is, "is the data on sheet2, in TABLE FORM?"

If it is, a pretty simple query-in-a-loop.

Skip,

_{[red]Be advised:[/red]When Viscounts were guillotined just as they were disclosing where their jewels were hidden, it shows to go that you should...
Never hatchet your Counts before they chicken!}

 

[Queryman]

Skip,
Thanks for your prompt reply.
I think it is in table form on sheet 2, so the value in column C in that sheet is "Speaker Programs" also.

Basically, Sheet 2 gets it's values from sheet2, but when I designed this, i did not realize that they would also need the five digit number in col A in sheet 2.



Michael

 

[SkipVought]

OK. It's still not clear to me what you are trying to do.

Is this...

Range("A2:J" & Range("b500").End(xlUp).Row).Copy

supposed to copy from row 2 ro row 500 in the opend workbook? If so...

Range(Cells(2,"A"), Cells(500,"J")).Copy

Then you paste in the first empty row in the original WB

Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

Where is the "five digit number in col A in sheet 2."??? Isn't that being copied?

What does this mean?

Basically, Sheet 2 gets it's values from sheet2

I AM CONFUSED!

Skip,

_{[red]Be advised:[/red]When Viscounts were guillotined just as they were disclosing where their jewels were hidden, it shows to go that you should...
Never hatchet your Counts before they chicken!}

 

[Queryman]

Sorry about the confusion, let me try to clarify.
The spreadsheets I am copying from have several tabs, i am only interested in copying from two of the tabs, most of the information I need is in SHEET3, but SHEET3 is missing a five digit number in every row. SHEET3 values are derived from SHEET2 row for row, so everything in SHEET2 is in SHEET3, except for column A in sheet2 which is not in SHEET3.

What I am trying to do, is copy all the rows in SHEET3 which have a value of "SPEAKER PROGRAMS" in column C, and also the value from column A of SHEET2 at the same time.

So, if one of the spreadsheets has 450 rows of info, and only five of those rows are for SPEAKER PROGRAMS, then I want to copy columsn A through J from sheet3 and columns A from sheet2 and paste those in my merge worksheet. I would then have to loop through the rest of the worksheets in that folder and do the same thing.

Does that help in clearing things up?
Thanks,





Michael

 

[SkipVought]

Sub MergeSheets()
    Dim SrcBook As Workbook
    Dim fso As Object, f As Object, ff As Object, f1 As Object
    Dim wkSht As Worksheet, iRow As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    wkSht = ActiveSheet
    
    On Error GoTo Bye
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.Getfolder("C:\TEMP\4-11\")
    Set ff = f.Files
    For Each f1 In ff
        Set SrcBook = Workbooks.Open(f1)
        For i = 2 To 3
            Select Case i
                Case 2
                    Sheets(i).Range(Cells(2, "A"), Cells(500, "J")).Copy
                    wkSht.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _
                        Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Case 3
                    For Each c In Sheets(i).Range(Cells(2, "c"), Cells(500, "c"))
                        If c.Value = "Speaker Programs" Then
                            c.EntireRow.Copy
                            lRow = wkSht.Range("A65536").End(xlUp).Offset(1, 0).Row
                            wkSht.Cells(lRow, "A").PasteSpecial _
                                Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                        End If
                    Next
            End Select
        Next
        SrcBook.Close
        Next
Bye:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Skip,

_{[red]Be advised:[/red]When Viscounts were guillotined just as they were disclosing where their jewels were hidden, it shows to go that you should...
Never hatchet your Counts before they chicken!}

 

[Queryman]

Skip,

Thanks for posting the code, but I am unable to get this to work. I thought since the worksheet I am copying from is protected I would add this code also

 Const PWORD As String = "MIKE"
    Set wkSht = ActiveSheet
     With ActiveSheet
         If .ProtectContents Then
            .Unprotect Password:=PWORD
         End If
     End With

I also have a question on this part

  For i = 2 To 3
            Select Case i
                Case 2
                    Sheets(i).Range(Cells(2, "A"), Cells(500, "J")).Copy
                    wkSht.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _
                        Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Case 3
                    For Each c In Sheets(i).Range(Cells(2, "c"), Cells(500, "c"))
                        If c.Value = "Speaker Programs" Then
                            c.EntireRow.Copy
                            lRow = wkSht.Range("A65536").End(xlUp).Offset(1, 0).Row
                            wkSht.Cells(lRow, "A").PasteSpecial _
                                Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                        End If
                    Next
            End Select
        Next

Is this copying just column A from sheet2 and columns A through J from sheet 3 where column C in sheet3 ="Speaker Programs" and is it pasting both pieces of information on one row?




Michael

 

[SkipVought]

I'm sorry -- I missed including some code...

        For i = 2 To 3
            Select Case i
                Case 2
                    Sheets(i).Range(Cells(2, "A"), Cells(500, "J")).Copy
                    wkSht.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _
                        Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Case 3
                    For Each c In Sheets(i).Range(Cells(2, "c"), Cells(500, "c"))
                        If c.Value = "Speaker Programs" Then
                            c.EntireRow.Copy
                            lRow = wkSht.Range("A65536").End(xlUp).Offset(1, 0).Row
                            wkSht.Cells(lRow, "B").PasteSpecial _
                                Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                            wkSht.Cells(lRow, "A").Value = Sheets(2).Cells(lRow, "A").Value
                        End If
                    Next
            End Select
        Next

Skip,

_{[red]Be advised:[/red]When Viscounts were guillotined just as they were disclosing where their jewels were hidden, it shows to go that you should...
Never hatchet your Counts before they chicken!}

 

[Queryman]

My apologies also, I forgot to mention that column C in sheet3 is a formula which gets it value from sheet2 same row, so when the code reads c.Value = "Speaker Programs", it will not work, because the value is a reference. Is there a way around this?
Thanks,



Michael

 

[SkipVought]

there's a difference between the reference and the value. the code tests the VALUE.

The REFERERNCE would be...

If c.[b]Formula[/b] = "Speaker Programs" Then
...

which would NOT be correct.

However, it tests the VALUE...

If c.[b]Value[/b] = "Speaker Programs" Then
...

and pastes the VALUES from the copied range

lRow = wkSht.Range("A65536").End(xlUp).Offset(1, 0).Row
wkSht.Cells(lRow, "B").PasteSpecial _
   Paste:=[b]xlValues[/b], Operation:=xlNone, SkipBlanks:=False, Transpose:=False

So you must be experiencing a problem of a different source.


Skip,

_{[red]Be advised:[/red]When Viscounts were guillotined just as they were disclosing where their jewels were hidden, it shows to go that you should...
Never hatchet your Counts before they chicken!}

 

[Queryman]

You are correct!

I will report back on this after further testing.
Thanks



Michael