ahsan_jalal
New Member
- Joined
- Dec 22, 2015
- Messages
- 4
Hello
Problem: I have a gc generated report from which i need to extract data and paste it in other excel sheet. For extraction, after browsing the file it should open xls file and run extraction of data script and then generated data should be copied in target file.
my second problem is there are 5 and 6 excel file to be treated in same way can, how can i apply for each file in that folder
Thanks in advance
Problem: I have a gc generated report from which i need to extract data and paste it in other excel sheet. For extraction, after browsing the file it should open xls file and run extraction of data script and then generated data should be copied in target file.
my second problem is there are 5 and 6 excel file to be treated in same way can, how can i apply for each file in that folder
Thanks in advance
Code:
Sub ww()
Dim gc_report As String
gc_report = Application.GetOpenFilename("*.xls,*.xls") 'browse txt file
Open gc_report For Input As #1 'Open GC report for interaction
'It will open GC report and do following operations
'Initializing Variables
Dim i As Integer
Dim rw As Integer ' For pasting in rw
Dim col As Integer 'for pasting in col
Dim a As Integer
Dim R1 As Variant
Dim rw1 As Integer
Dim col1 As Integer
Dim myRange As Range
Dim NumRows As Integer
Set myRange = Range("C:C")
NumRows = Application.WorksheetFunction.CountA(myRange)
'Condition to check either its remaining or 15 IL pack
If NumRows = 2970 Then
' copy IL list
Range("B8:B22").Select
Selection.Copy
Range("J6").Select
ActiveSheet.Paste
'Write data
rw = 24
col = 3
a = 0
rw1 = 6
col1 = 11
For i = 1 To 165
Cells(rw, col).Select 'Copy matched item
R1 = ActiveCell.Value
Cells(rw1, col1 + a).Value = R1
rw = rw + 27
a = a + 1
If a = 11 Then 'condition to paste in row uptill 323
a = 0
rw1 = rw1 + 1 ' Change row
End If
Next i
ElseIf NumRows = 1056 Then
' copy IL list
Range("B8:B15").Select
Selection.Copy
Range("J6").Select
ActiveSheet.Paste
'Write data
rw = 18
col = 3
a = 0
rw1 = 6
col1 = 11
For i = 1 To 88
Cells(rw, col).Select
R1 = ActiveCell.Value
Cells(rw1, col1 + a).Value = R1
rw = rw + 21
a = a + 1
If a = 11 Then 'condition to paste in row uptill 323
a = 0
rw1 = rw1 + 1 ' Change row
End If
Next i
Else
MsgBox ("There is error")
End If
' When Operation is done it will copy generated data in gc report and copyit into desired workbook
Range("J6:U20").Select
Selection.Copy
Windows("1-butene").Activate
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("1-butene")
'find first empty row in database
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
Range("irow,1").Select
ActiveSheet.Paste
End Sub