Need help with VBA code. Many thanks in advance!

[ratsmdj]

This is a modified script from this forum and it serves it purpose well. But I the issue I am having now is that currently the script copies a bunch of values from a DIR and paste it in the main worksheet.

But in this the DIR the tab names of the sheet varies so the code breaks when it encounters this change. So lets say I have 100 excel files in there, it scans through and copies and on lets say the 7th file which is identical to other files, but the tab name is diff. It stops working ending with a script error:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Const strPath As String = "C:\Users\xxx\1-DUMP2\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            .Sheets("Commission").Range("C22").Copy
            wkbDest.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats, _
                Operation:=xlNone, SkipBlanks:=True, Transpose:=False
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.CutCopyMode = False
    
End Sub

I tried referencing it by code name instead of sheet name. So where it says:

 .Sheets("Commission").Range("C22").Copy

I changed it to:

Sheet1.Range("C22").Copy

And it looks like it is doing something. But the entries keep coming back blank. Any thoughts how I can achieve this?

And the tab name varies between just three types, Either Commission or USD Commission or AUD Commission

Thank you again!

 

[sadboy309]

You need 1 {For each Sheet in wkbSource.WorkSheets} to find name Sheet. So code:

...
With wkbSource

For each Sh in wkbSource.WorkSheets
If Sh.Name Like "*Com*" Then
Sh.Range("C22").Copy
...

End If
Next

End With
...

 

[ratsmdj]

Thank you soo MUCH!! It works.

Sub CopyRange()    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Const strPath As String = "C:\Users\xxx\1-DUMP2\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            For Each Sh In wkbSource.Worksheets
                If Sh.Name Like "*Com*" Then
                Sh.Range("C22").Copy
            wkbDest.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats, _
                Operation:=xlNone, SkipBlanks:=True, Transpose:=False
            .Close savechanges:=False
            
            End If
            Next
            
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.CutCopyMode = False
    
    
    
End Sub

One question is there a way for me to pull multiple ranges of data? So right now it is grabbing all data from C22 and inputting it into a sheet on column A row 2, I want to in the same dir of 100 excel sheets to pull data from C8 and input it into Column B row 2

So i can match the two and confirm that it is correct. I tried to modify to rerun the steps again but obviously it doesnt work. The only way I can think of it to work is to create multiple VBAs one for c22 and another for c8 and combining the two together.

Many thanks again for your help!

 

[sadboy309]

Code:

Sh.Range("C22").Copy
wkbDest.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValuesAndNumberFormats, _
                Operation:=xlNone, SkipBlanks:=True, Transpose:=False

Change it:

lst = wkbDest.Sheets("Sheet1").Cells(wkbDest.Sheets("Sheet1").Rows.Count,"A").End(xlUp).Row + 1
wkbDest.Sheets("Sheet1").Range("A" & lst ) = Sh.Range("C22").value
wkbDest.Sheets("Sheet1").Range("B" & lst ) = Sh.Range("C8").value

 

[ratsmdj]

Thank much again for the prompt response! Went from copying data for a week to being done in 30 min. Thank you again! And i tried to edit teh code my self and with your answer I WAS WAYYYYY OFF lol

Now one last tid bit.

For the AUD sheets, the commission is correct, which shows up in C22, and the reporting data is in C8.

But for these sheets, i dont want to call C22 since I need the USD converted amount which is in C32.

Is there a way to put an IF statement or something if cell c22 has the words "AUD 180.70" move to c32 and copy that instead? Majority of the sheets are in USD so the C22/C8 combo works, but for the small handful that is AUD, if possible to copy as C32/C8?

Thanks again!