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/showthread.php?61805-loop-through-files-in-a-folder-based-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..