VBA Problem in interacting other excel files

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


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
 
Does your code do what you want it to do (for one workbook)? You are not clear on that. If it is not doing what you want it to, what is wrong?

To adjust this to all workbooks in a folder, do a search on 'loop through workbooks in folder'.
 
Upvote 0

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