Macro for summary making

[sujan7788]

Sub Import_Text_Files()

Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String


Application.ScreenUpdating = False


sDelimiter = "|"


FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.PRO), *.PRO", _
MultiSelect:=True, Title:="Text Files to Open")


If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
End If


x = 1
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
wkbTemp.Sheets(1).Copy
Set wkbAll = ActiveWorkbook
wkbTemp.Close (False)
wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Tab:=False, Semicolon:=False, _
Comma:=True, Space:=True, _
Other:=False, OtherChar:=","
x = x + 1


While x <= UBound(FilesToOpen)
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
With wkbAll
wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=True, _
Other:=False, OtherChar:=sDelimiter
End With
x = x + 1
Wend
Application.ScreenUpdating = True

Rows(4).EntireRow.Delete
Rows(3).EntireRow.Delete
Rows(2).EntireRow.Delete
Rows(1).EntireRow.Delete
Columns("A:A").EntireColumn.Delete
Range("A1").EntireRow.Insert
Cells(1, 1).Value = "Sum"

End Sub


Hi, I want to upload some text files in . PRO format. i was able to do it.But then i wanted to perform the bolted actions on all those worksheets. but its performed only on 1 worksheet. Please provide me advice to do the bolted ones on all the worksheets.
Thanks

 

[Alex Blakenburg]

You can try replacing your bolded lines with this:-

    Dim sht As Worksheet
    For Each sht In wkbAll.Worksheets
        With sht
            .Rows(4).EntireRow.Delete
            .Rows(3).EntireRow.Delete
            .Rows(2).EntireRow.Delete
            .Rows(1).EntireRow.Delete
            .Columns("A:A").EntireColumn.Delete
            .Range("A1").EntireRow.Insert
            .Cells(1, 1).Value = "Sum"
        End With
    Next sht

 

[sujan7788]

Sub Import_Text_Files()

Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String


Application.ScreenUpdating = False


sDelimiter = "|"


FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.PRO), *.PRO", _
MultiSelect:=True, Title:="Text Files to Open")


If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
End If


x = 1
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
wkbTemp.Sheets(1).Copy
Set wkbAll = ActiveWorkbook
wkbTemp.Close (False)
wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Tab:=False, Semicolon:=False, _
Comma:=True, Space:=True, _
Other:=False, OtherChar:=","
x = x + 1


While x <= UBound(FilesToOpen)
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
With wkbAll
wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=True, _
Other:=False, OtherChar:=sDelimiter
End With
x = x + 1
Wend
Application.ScreenUpdating = True

Dim sht As Worksheet
For Each sht In wkbAll.Worksheets
With sht
.Rows(4).EntireRow.Delete
.Rows(3).EntireRow.Delete
.Rows(2).EntireRow.Delete
.Rows(1).EntireRow.Delete
.Columns("A:A").EntireColumn.Delete
.Range("A1").EntireRow.Insert
.Cells(1, 1).Value = "Sum"
End With
Next sht


End Sub

Hi i tried like this. Gives the same problem. thanks for help

 

[Alex Blakenburg]

Please use the vba button when you post code, so it's easier to read.
Is the data on multiple sheets or multiple workbooks ?