need help in looping

[dsnaveen]

Sub All()
    Application.DisplayAlerts = False
    Set this_wb = ThisWorkbook
        Set wb = Workbooks.Open("C:\Desktop\VBA\V7.xlsx")
        wb.Sheets("Monthly_tab4").Select
        Range("B4:o30").Copy
        this_wb.Sheets("Data").Range("A1").PasteSpecial Paste:=xlPasteValues
        wb.Sheets("Monthly_tab5").Select
        Range("B4:o30").Copy
        this_wb.Sheets("Data").Range("A35").PasteSpecial Paste:=xlPasteValues
        wb.Sheets("Monthly_tab6").Select
        Range("B4:o29").Copy
        this_wb.Sheets("Data").Range("A65").PasteSpecial Paste:=xlPasteValues
        wb.Sheets("Monthly_tab7").Select
        Range("B4:o25").Copy
        this_wb.Sheets("Data").Range("A90").PasteSpecial Paste:=xlPasteValues
        wb.Close
End Sub

Hello,


I have a excel file, in the file, there are 8 tabs, out of 8 tabs i need to take 4 tabs
i.,e Monthly_tab4, Monthly_tab5, Monthly_tab6, Monthly_tab7.


Above code is working for 1 file, i have range for each tabs as below, output is correct for 1 file.
Monthly_tab4 - B4:o30
Monthly_tab5 - B4:o30
Monthly_tab6 - B4:o29
Monthly_tab7 - B4:o25


Like this there were be around 70 files, if there are 70 files what changes needs to be done, can somebody help please.


Thanks,

[June7]

Please use CODE tags, not QUOTE tags, for code. Use # icon on post edit toolbar.

Files are identical in structure?

You need to loop through files in folder? Review http://www.vbaexpress.com/forum/show...on-a-condition

[dsnaveen]

Thank you for the reply..
Files are identical in structure? --Yes
You need to loop through files in folder? -- Yes

[June7]

Did you try adapting code from example in link?

[dsnaveen]

Sub All()
Application.DisplayAlerts = False
Set this_wb = ThisWorkbook


Set wb = Workbooks.Open("C:\Desktop\VBA\V7.xlsx")
Dim rngNames    As Range
Dim wks         As Worksheet


        Set wks = wb.Sheets("Monthly_tab4").Select
        Set rngNames = wks.Range("B4:o30").Copy
        
        'Loop through all the values in NamedRange
        For Each rngName In rngNames
            ' Verify the Named Range exists.
            On Error Resume Next
                Set dstRng = wb.Sheets("Monthly_tab4").Select
                If Err = 0 Then
                    ' Create a link from the Template worksheet to the Report Balance.
                    dstRng.Value = rngName.Offset(0, 1).Value
                    dstRng.Offset(0, -2).Formula = "=" & rngName.Offset(0, 1).Address(True, Ture, xlA1, True)
                Else
                    'answer = MsgBox("The Named Range """ & rngName.Value & """ Does Not Exist" & vbLf & vbLf & "Continue?", vbYesNo + vbExclamation)
                    'If answer = vbNo Then Exit Sub
                End If
            On Error GoTo 0
        Next rngName


wb.Close
End Sub

Thanks, for reply.
I checked the link provided.
For time being, i have taken 1 sheet (Monthly_tab4). It says object required.. any ideas please...

[June7]

Your code is not looping through files. But I guess need to deal with that later.

Seldom have to "Select" anything when automating Excel.

Suggest you provide db for analysis and testing.

[Aussiebear]

This is an example of looping through all files in a folder

Sub LoopAllFilesInAFolder()
'Loop through all files in a folder
Dim fileName As Variant
fileName = Dir("C:\Users\Alice\Documents\")
While fileName <> ""
    'Insert the actions to be performed on each file
    'This example will print the file name to the immediate window
    Debug.Print fileName
'Set the fileName to the next file
    fileName = Dir
Wend
End Sub

These are very simple examples of actions taken when looping through each file.

'Loop through each file with an extension of ".xlsx"
fileName = Dir("C:\Users\marks\Documents\*.xlsx")

'Loop through each file containing the word "January" in the filename
fileName = Dir("C:\Users\marks\Documents\*January*")

'Loop through each text file in a folder
fileName = Dir("C:\Users\marks\Documents\*.txt")

I'm assuming that you have multiple workbooks all set out the same here?

[dsnaveen]

Sub ConsolidateDataFromMultipleFiles()    Dim SourceFolder As String
    Dim FileExt As String
    Dim FileName As String
    Dim wbSource As Workbook
    Dim wsSource1 As Worksheet, wsSource2 As Worksheet, wsSource3 As Worksheet, wsSource4 As Worksheet
    Dim wsDest As Worksheet
    Dim DestRow As Long


    ' Set the source folder path and file extension
    SourceFolder = "C:\goldsim\TEST_1\"
    FileExt = "*.xlsx" ' Change to your file extension


    ' Set the destination worksheet
    Set wsDest = ThisWorkbook.Sheets("ConsolidatedData") ' Change to your destination sheet name


    ' Clear existing data in the destination sheet
    wsDest.Cells.Clear


    ' Loop through each file in the folder
    FileName = Dir(SourceFolder & FileExt)
    Do While FileName <> ""
        Set wbSource = Workbooks.Open(SourceFolder & FileName, ReadOnly:=True)


        ' Set references to source worksheets
        Set wsSource1 = wbSource.Sheets("Monthly_1") ' Change to your sheet names
        Set wsSource2 = wbSource.Sheets("Monthly_2")
        Set wsSource3 = wbSource.Sheets("Monthly_3")
        Set wsSource4 = wbSource.Sheets("Monthly_4")


        ' Copy data from source sheets to destination sheet
        wsSource1.Range("B4:o30").Copy
        wsDest.Cells(DestRow + 1, 1).PasteSpecial xlPasteValues


        wsSource2.Range("B4:o30").Copy
        wsDest.Cells(DestRow + 11, 1).PasteSpecial xlPasteValues


        wsSource3.Range("B4:o29").Copy
        wsDest.Cells(DestRow + 26, 1).PasteSpecial xlPasteValues


        wsSource4.Range("B4:o25").Copy
        wsDest.Cells(DestRow + 47, 1).PasteSpecial xlPasteValues


        ' Update the destination row counter
        DestRow = DestRow + 72 ' Adjust this based on the number of rows copied


        ' Close the source workbook
        wbSource.Close SaveChanges:=False
        FileName = Dir
    Loop
End Sub

Thanks for the reply.
I have taken 4 sheets, the looping part is not working.
I have used ChatGPT for this, i did not get this part
"' Adjust this based on the number of rows copied"
The data is getting overlapped, i have attached the source file,
can somebody please let me know what changes needs to be done..


Thanks,

[dsnaveen]

Hello guys, can somebody please help on this...

[georgiboy]

Maybe try it as below:

Sub ConsolidateDataFromMultipleFiles()
    Dim SourceFolder As String
    Dim FileExt As String
    Dim FileName As String
    Dim wbSource As Workbook
    Dim wsSource1 As Worksheet, wsSource2 As Worksheet, wsSource3 As Worksheet, wsSource4 As Worksheet
    Dim wsDest As Worksheet

    ' Set the source folder path and file extension
    SourceFolder = "C:\goldsim\TEST_1\"
    FileExt = "*.xlsx" ' Change to your file extension

    ' Set the destination worksheet
    Set wsDest = ThisWorkbook.Sheets("ConsolidatedData") ' Change to your destination sheet name

    ' Clear existing data in the destination sheet
    wsDest.Cells.Clear

    ' Loop through each file in the folder
    FileName = Dir(SourceFolder & FileExt)
    Do While FileName <> ""
        Set wbSource = Workbooks.Open(SourceFolder & FileName, ReadOnly:=True)

        ' Set references to source worksheets
        Set wsSource1 = wbSource.Sheets("Monthly_1") ' Change to your sheet names
        Set wsSource2 = wbSource.Sheets("Monthly_2")
        Set wsSource3 = wbSource.Sheets("Monthly_3")
        Set wsSource4 = wbSource.Sheets("Monthly_4")

        ' Copy data from source sheets to destination sheet
        wsSource1.UsedRange.Copy
        wsDest.Range("A" & wsDest.Range("B" & Rows.Count).End(xlUp).Row + 2).PasteSpecial (11)

        wsSource2.UsedRange.Copy
        wsDest.Range("A" & wsDest.Range("B" & Rows.Count).End(xlUp).Row + 2).PasteSpecial (11)

        wsSource3.UsedRange.Copy
        wsDest.Range("A" & wsDest.Range("B" & Rows.Count).End(xlUp).Row + 2).PasteSpecial (11)

        wsSource4.UsedRange.Copy
        wsDest.Range("A" & wsDest.Range("B" & Rows.Count).End(xlUp).Row + 2).PasteSpecial (11)
        
        Application.CutCopyMode = False

        wbSource.Close SaveChanges:=False
        FileName = Dir
    Loop
End Sub

[dsnaveen]

Thank you for the quick reply.


Its copying all the data.
Also in ConsolidatedData, value is coming as =SUM(D8:O8),
need values and ignore all formats & formulas


I tried using the below logic to get the range, its not working
wsDest.Range("B4:o30").PasteSpecial (11)

[georgiboy]

Try amending to the below:

wsSource1.Range("B4:O30").Copy
wsDest.Range("A" & wsDest.Range("A" & Rows.Count).End(xlUp).Row + 2).PasteSpecial xlPasteValues

[dsnaveen]

Thank you, it worked perfectly..

[dsnaveen]

Hi, Need 1 help.
a. I need the filename in output, i tried the below code, this is now working in the above code
FileNameWOExt = Left(FileName, InStr(FileName, ".") - 1)
b. how to give Monthly_1, Monthly_2.. hardcode in sheet.
I need to give the sheet name in the rows.
Any suggestion please..