Level of Excel (God)

T

Tofik

Board Regular
Joined
Feb 4, 2021
Messages
114
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi Guys, the new challenge for you ?
It can be harder to create but I saw from one guy who used this function in excel in our job and won't create the same thing.
I have a lot of the same routine reports in my folder on my PC for example my C:\Folder With reports and all reports structures are the same ( only some values can be dinamic ).

1617988516455.png

and now I want to collect all information in one excel file (for example A1 from all reports in a folder to one excel file )

and if I know that, all excel files in the folder have the same table ( table are static ), and only value in those cells are changing ( Dynamic )
all reports in this condition :
CON-PIP-12-T-S001.xlsx
ABCDEFGHI
1NoExample of infodate
2report NO 0001
31same name in all reportsvalue which dinamicvalue which dinamicvalue which dinamic
42same name in all reportsvalue which dinamicvalue which dinamicvalue which dinamic
53same name in all reportsvalue which dinamicvalue which dinamicvalue which dinamic
64same name in all reportsvalue which dinamicvalue which dinamicvalue which dinamic
75
86
97
108
119
Sheet3


How it should be in one excel :
CON-PIP-12-T-S001.xlsx
ABCDEFGHI
1NoExample of infodate
2report NO 0001
31same name in all reportsvalue which dinamicvalue which dinamicvalue which dinamic
42same name in all reportsvalue which dinamicvalue which dinamicvalue which dinamic
53same name in all reportsvalue which dinamicvalue which dinamicvalue which dinamic
64same name in all reportsvalue which dinamicvalue which dinamicvalue which dinamic
75
86
97
108
119
12
13
14NoExample of infodate
15report NO 0002
161same name in all reportsvalue which dinamicvalue which dinamicvalue which dinamic
172same name in all reportsvalue which dinamicvalue which dinamicvalue which dinamic
183same name in all reportsvalue which dinamicvalue which dinamicvalue which dinamic
194same name in all reportsvalue which dinamicvalue which dinamicvalue which dinamic
205
216
227
238
249
Sheet3



the reason why I need this because of the routine which kills me to open one excel to copy info to my final Log and also my laptop has only 4 Ram which freezing all the time and I spend so much time on it.
I can automate the system which can save my time to copy-paste all info into one.

Thank you, guys. If you can solve it, it will be perfect for me and also thanks for your time.
 
Sort by date Sort by votes

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
Try this. This macro Add Report Number to Column1 & Drawing ReD Part to Last Column.
AND When You See window for selecting file location, Only Select your Report folder (Don't open Folder)
VBA Code: 
Sub ImportFiles3()
Dim xWS As Worksheet, xTWB As Workbook, DestSheet As Worksheet, Head As Range
Dim xStrAWBName As String, FolderName As String, sItem As String, Header As Long
Dim FolderPath As String, fldr As FileDialog, Lr As Long, LCD As Long, R As Long
Dim os As Long, LrS As Long, LCS As Long, FileName As String
On Error Resume Next
Set xTWB = ThisWorkbook
Set DestSheet = xTWB.ActiveSheet
  Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    FolderName = sItem
    Set fldr = Nothing
    FolderPath = FolderName & "\"
FileName = Dir(FolderPath & "*.xls*")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Do While FileName <> ""
Workbooks.Open FileName:=FolderPath & FileName, ReadOnly:=True
xStrAWBName = ActiveWorkbook.Name
For Each xWS In ActiveWorkbook.Sheets
If xWS.Name = "10140-CON-PIP-12" Then
Lr = DestSheet.Range("A" & Rows.Count).End(xlUp).Row
LrS = Application.WorksheetFunction.Count(xWS.Range("A11:A26"))
LCS = xWS.Cells(1, Columns.Count).End(xlToLeft).Column + 1
LCD = DestSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1
If Lr = 1 Then
Range(xWS.Cells(9, 1), xWS.Cells(10, 35)).Copy DestSheet.Range("B1")
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy Range(DestSheet.Cells(3, 2), DestSheet.Cells(LrS + 2, 36))
DestSheet.Range("A1").Value = "Report Number"
Range(DestSheet.Cells(3, 1), DestSheet.Cells(LrS + 2, 1)).Value = xWS.Range("D7").Value
DestSheet.Cells(1, 37).Value = "Drawing"
Range(DestSheet.Cells(3, 37), DestSheet.Cells(LrS + 2, 37)).Value = Trim(Right(xWS.Range("V4").Value, Len(xWS.Range("V4").Value) - Application.WorksheetFunction.Find("/", xWS.Range("V4").Value)))
Range(xWS.Cells(9, 1), xWS.Cells(10, 35)).Copy
Range(DestSheet.Cells(1, 2), DestSheet.Cells(2, 37)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 1)).Copy
Range(DestSheet.Cells(3, 1), DestSheet.Cells(LrS + 2, 1)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy
Range(DestSheet.Cells(3, 2), DestSheet.Cells(LrS + 2, 37)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(DestSheet.Cells(1, 2), DestSheet.Cells(2, 2)).Copy
Range(DestSheet.Cells(1, 1), DestSheet.Cells(2, 1)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy Range(DestSheet.Cells(Lr + 1, 2), DestSheet.Cells(Lr + LrS, 36))
Range(DestSheet.Cells(Lr + 1, 1), DestSheet.Cells(Lr + LrS, 1)).Value = xWS.Range("D7").Value
Range(DestSheet.Cells(Lr + 1, 37), DestSheet.Cells(Lr + LrS, 37)).Value = Trim(Right(xWS.Range("V4").Value, Len(xWS.Range("V4").Value) - Application.WorksheetFunction.Find("/", xWS.Range("V4").Value)))
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy
Range(DestSheet.Cells(Lr + 1, 2), DestSheet.Cells(Lr + LrS, 37)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 1)).Copy
Range(DestSheet.Cells(Lr + 1, 1), DestSheet.Cells(Lr + LrS, 1)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
End If
Next xWS
Workbooks(xStrAWBName).Close
FileName = Dir()
Loop
DestSheet.Columns("A:AK").WrapText = False
DestSheet.Columns("A:AK").AutoFit
DestSheet.Name = "Consolidate"
xTWB.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
 
Last edited:
Upvote 0
maabadi said:
Try this. This macro Add Report Number to Column1 & Drawing ReD Part to Last Column.
AND When You See window for selecting file location, Only Select your Report folder (Don't open Folder)
VBA Code: 
Sub ImportFiles3()
Dim xWS As Worksheet, xTWB As Workbook, DestSheet As Worksheet, Head As Range
Dim xStrAWBName As String, FolderName As String, sItem As String, Header As Long
Dim FolderPath As String, fldr As FileDialog, Lr As Long, LCD As Long, R As Long
Dim os As Long, LrS As Long, LCS As Long, FileName As String
On Error Resume Next
Set xTWB = ThisWorkbook
Set DestSheet = xTWB.ActiveSheet
  Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    FolderName = sItem
    Set fldr = Nothing
    FolderPath = FolderName & "\"
FileName = Dir(FolderPath & "*.xls*")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Do While FileName <> ""
Workbooks.Open FileName:=FolderPath & FileName, ReadOnly:=True
xStrAWBName = ActiveWorkbook.Name
For Each xWS In ActiveWorkbook.Sheets
If xWS.Name = "10140-CON-PIP-12" Then
Lr = DestSheet.Range("A" & Rows.Count).End(xlUp).Row
LrS = Application.WorksheetFunction.Count(xWS.Range("A11:A26"))
LCS = xWS.Cells(1, Columns.Count).End(xlToLeft).Column + 1
LCD = DestSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1
If Lr = 1 Then
Range(xWS.Cells(9, 1), xWS.Cells(10, 35)).Copy DestSheet.Range("B1")
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy Range(DestSheet.Cells(3, 2), DestSheet.Cells(LrS + 2, 36))
DestSheet.Range("A1").Value = "Report Number"
Range(DestSheet.Cells(3, 1), DestSheet.Cells(LrS + 2, 1)).Value = xWS.Range("D7").Value
DestSheet.Cells(1, 37).Value = "Drawing"
Range(DestSheet.Cells(3, 37), DestSheet.Cells(LrS + 2, 37)).Value = Trim(Right(xWS.Range("V4").Value, Len(xWS.Range("V4").Value) - Application.WorksheetFunction.Find("/", xWS.Range("V4").Value)))
Range(xWS.Cells(9, 1), xWS.Cells(10, 35)).Copy
Range(DestSheet.Cells(1, 2), DestSheet.Cells(2, 37)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 1)).Copy
Range(DestSheet.Cells(3, 1), DestSheet.Cells(LrS + 2, 1)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy
Range(DestSheet.Cells(3, 2), DestSheet.Cells(LrS + 2, 37)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(DestSheet.Cells(1, 2), DestSheet.Cells(2, 2)).Copy
Range(DestSheet.Cells(1, 1), DestSheet.Cells(2, 1)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy Range(DestSheet.Cells(Lr + 1, 2), DestSheet.Cells(Lr + LrS, 36))
Range(DestSheet.Cells(Lr + 1, 1), DestSheet.Cells(Lr + LrS, 1)).Value = xWS.Range("D7").Value
Range(DestSheet.Cells(Lr + 1, 37), DestSheet.Cells(Lr + LrS, 37)).Value = Trim(Right(xWS.Range("V4").Value, Len(xWS.Range("V4").Value) - Application.WorksheetFunction.Find("/", xWS.Range("V4").Value)))
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy
Range(DestSheet.Cells(Lr + 1, 2), DestSheet.Cells(Lr + LrS, 37)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 1)).Copy
Range(DestSheet.Cells(Lr + 1, 1), DestSheet.Cells(Lr + LrS, 1)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
End If
Next xWS
Workbooks(xStrAWBName).Close
FileName = Dir()
Loop
DestSheet.Columns("A:AK").WrapText = False
DestSheet.Columns("A:AK").AutoFit
DestSheet.Name = "Consolidate"
xTWB.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
Click to expand...
I have 2 questions
1) how to launch the process?
2) how to show location?
 
Upvote 0
1. At the excel window, Press ALT+F11
2.At the window appears, Slelect Insert, then Module
3. At the window appears at right side, paste code I sent at previous post.
4. Close this window (VBA window)
5. At the Excel window Go to View Tab
Select Macros & then View Macros
6. Select Importfiles3 and Then Press Run.
7. Your code start running. At the windows appears, Select folders have report (Don't Open it).
8. Code run to end & your file is ready.
9. If you want use macro Later also , Save your file As Macro-Enabled Workbook (.xlsm).
 
Upvote 0
maabadi said:
Try this. This macro Add Report Number to Column1 & Drawing ReD Part to Last Column.
AND When You See window for selecting file location, Only Select your Report folder (Don't open Folder)
VBA Code: 
Sub ImportFiles3()
Dim xWS As Worksheet, xTWB As Workbook, DestSheet As Worksheet, Head As Range
Dim xStrAWBName As String, FolderName As String, sItem As String, Header As Long
Dim FolderPath As String, fldr As FileDialog, Lr As Long, LCD As Long, R As Long
Dim os As Long, LrS As Long, LCS As Long, FileName As String
On Error Resume Next
Set xTWB = ThisWorkbook
Set DestSheet = xTWB.ActiveSheet
  Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    FolderName = sItem
    Set fldr = Nothing
    FolderPath = FolderName & "\"
FileName = Dir(FolderPath & "*.xls*")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Do While FileName <> ""
Workbooks.Open FileName:=FolderPath & FileName, ReadOnly:=True
xStrAWBName = ActiveWorkbook.Name
For Each xWS In ActiveWorkbook.Sheets
If xWS.Name = "10140-CON-PIP-12" Then
Lr = DestSheet.Range("A" & Rows.Count).End(xlUp).Row
LrS = Application.WorksheetFunction.Count(xWS.Range("A11:A26"))
LCS = xWS.Cells(1, Columns.Count).End(xlToLeft).Column + 1
LCD = DestSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1
If Lr = 1 Then
Range(xWS.Cells(9, 1), xWS.Cells(10, 35)).Copy DestSheet.Range("B1")
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy Range(DestSheet.Cells(3, 2), DestSheet.Cells(LrS + 2, 36))
DestSheet.Range("A1").Value = "Report Number"
Range(DestSheet.Cells(3, 1), DestSheet.Cells(LrS + 2, 1)).Value = xWS.Range("D7").Value
DestSheet.Cells(1, 37).Value = "Drawing"
Range(DestSheet.Cells(3, 37), DestSheet.Cells(LrS + 2, 37)).Value = Trim(Right(xWS.Range("V4").Value, Len(xWS.Range("V4").Value) - Application.WorksheetFunction.Find("/", xWS.Range("V4").Value)))
Range(xWS.Cells(9, 1), xWS.Cells(10, 35)).Copy
Range(DestSheet.Cells(1, 2), DestSheet.Cells(2, 37)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 1)).Copy
Range(DestSheet.Cells(3, 1), DestSheet.Cells(LrS + 2, 1)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy
Range(DestSheet.Cells(3, 2), DestSheet.Cells(LrS + 2, 37)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(DestSheet.Cells(1, 2), DestSheet.Cells(2, 2)).Copy
Range(DestSheet.Cells(1, 1), DestSheet.Cells(2, 1)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy Range(DestSheet.Cells(Lr + 1, 2), DestSheet.Cells(Lr + LrS, 36))
Range(DestSheet.Cells(Lr + 1, 1), DestSheet.Cells(Lr + LrS, 1)).Value = xWS.Range("D7").Value
Range(DestSheet.Cells(Lr + 1, 37), DestSheet.Cells(Lr + LrS, 37)).Value = Trim(Right(xWS.Range("V4").Value, Len(xWS.Range("V4").Value) - Application.WorksheetFunction.Find("/", xWS.Range("V4").Value)))
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 35)).Copy
Range(DestSheet.Cells(Lr + 1, 2), DestSheet.Cells(Lr + LrS, 37)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range(xWS.Cells(11, 1), xWS.Cells(11 + LrS - 1, 1)).Copy
Range(DestSheet.Cells(Lr + 1, 1), DestSheet.Cells(Lr + LrS, 1)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
End If
Next xWS
Workbooks(xStrAWBName).Close
FileName = Dir()
Loop
DestSheet.Columns("A:AK").WrapText = False
DestSheet.Columns("A:AK").AutoFit
DestSheet.Name = "Consolidate"
xTWB.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
Click to expand...
Yeeeeeeeeeeeeeees!
Thank you my friend for your time. It was the perfect code that gave me everything that I looking for.
The macros is working and you made my day )))))
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question
How to Use "GetPivotData" formula to retrieve data from a closed workbook
Replies
3
Views
270
RoryA
RoryA
M
  • Question
Doubt in Excel and PowerBI
Replies
0
Views
120
manas0806
M
J
  • Question
How can I create a list from a single layer of a directory?
Replies
6
Views
302
PeteWright
PeteWright
L
  • Question
Insert WAV file in Col on next available row
Replies
0
Views
172
Ligg
L
S
  • Question
Trendline values using Dynamic Range in Excel - comparing with LINEST function
Replies
1
Views
182
Domenic
D

Forum statistics

Threads
1,214,591
Messages
6,120,432
Members
448,961
Latest member
nzskater

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top