I have a Workbook that imports data from a vendor sheet. The vendor Worksheet Column A is dynamic so it will change from time to time. The import file should copy the appropriate data to an input sheet in my workbook so the data can be verified before transferring to a log. I created a For Loop to loop through all the rows in column A looking for a specific value. Once the value is found I used the OFFSET function to copy data from different columns in the same row. As you will see they are not successive columns. The code works fine for copying data from one column, however when I try to copy all the necessary data from each column it returns nothing. Could you please help me understand why this is happening? Thank you so very much for any and all help.
Sub ImportData()
Dim FileOpen As Variant
Dim OpenBook As Workbook
Dim i As Integer
Application.ScreenUpdating = False
FileOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files(*.xls*),*xls*")
If FileOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileOpen)
OpenBook.Sheets(1).Range("E11:F100").Replace What:="U", Replacement:=""
OpenBook.Sheets(1).Range("E11:F100").Replace What:="i", Replacement:=""
'Date & Time
OpenBook.Sheets(1).Range("E9").Copy
ThisWorkbook.Worksheets("Input").Range("B10").PasteSpecial xlPasteValues
OpenBook.Sheets(1).Range("E10").Copy
ThisWorkbook.Worksheets("Input").Range("B11").PasteSpecial xlPasteValues
OpenBook.Sheets(1).Range("F9").Copy
ThisWorkbook.Worksheets("Input").Range("C10").PasteSpecial xlPasteValues
OpenBook.Sheets(1).Range("F10").Copy
ThisWorkbook.Worksheets("Input").Range("C11").PasteSpecial xlPasteValues
'Plant Name
OpenBook.Sheets(1).Range("B4").Copy
ThisWorkbook.Worksheets("Input").Range("D11").PasteSpecial xlPasteValues
'pH
For i = 11 To 100
If OpenBook.Sheets(1).Range("A" & i).Value = "Sales" Then
OpenBook.Sheets(1).Range("A" & i).Offset(0, 5).Copy
ThisWorkbook.Worksheets("Input").Range("B24").PasteSpecial xlPasteValues
OpenBook.Sheets(1).Range("A" & i).Offset(0, 6).Copy
ThisWorkbook.Worksheets("Input").Range("C24").PasteSpecial xlPasteValues
OpenBook.Sheets(1).Range("A" & i).Offset(0, 2).Copy
ThisWorkbook.Worksheets("Input").Range("D24").PasteSpecial xlPasteValues
End If
Next i
OpenBook.Close False
End If
Application.ScreenUpdating = True
End Sub
CodePudding user response:
This is your code with the added extra, of increasing row numbers on the import sheet for each new row of data, as well as avoiding the copy paste function.
Sub ImportData()
Dim FileOpen As Variant
Dim OpenBook As Workbook
Dim i As Integer
Dim RNmbr As Integer ' Row Number on the import sheet
Application.ScreenUpdating = False
FileOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files(*.xls*),*xls*")
If FileOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileOpen)
OpenBook.Sheets(1).Range("E11:F100").Replace What:="U", Replacement:=""
OpenBook.Sheets(1).Range("E11:F100").Replace What:="i", Replacement:=""
'Date & Time
ThisWorkbook.Worksheets("Input").Range("B10").Value = OpenBook.Sheets(1).Range("E9").Value
ThisWorkbook.Worksheets("Input").Range("B11").Value = OpenBook.Sheets(1).Range("E10").Value
ThisWorkbook.Worksheets("Input").Range("C10").Value = OpenBook.Sheets(1).Range("F9").Value
ThisWorkbook.Worksheets("Input").Range("C11").Value = OpenBook.Sheets(1).Range("F10").Value
'Plant Name
ThisWorkbook.Worksheets("Input").Range("D11").Value = OpenBook.Sheets(1).Range("B4").Value
'pH
RNmbr = 24 ' This is the starting row number
For i = 11 To 100
If OpenBook.Sheets(1).Range("A" & i).Value = "Sales" Then
ThisWorkbook.Worksheets("Input").Range("B" & RNmbr).Value = OpenBook.Sheets(1).Range("A" & i).Offset(0, 5).Value
ThisWorkbook.Worksheets("Input").Range("C" & RNmbr).Value = OpenBook.Sheets(1).Range("A" & i).Offset(0, 6).Value
ThisWorkbook.Worksheets("Input").Range("D" & RNmbr).Value = OpenBook.Sheets(1).Range("A" & i).Offset(0, 2).Value
RNmbr = RNmbr 1 ' increase the row number ready for the next set of data import
End If
Next i
OpenBook.Close False
End If
Application.ScreenUpdating = True
End Sub
Please be aware, every time this script runs it will overwrite any data currently on the import sheet from the row number specified. If you want to keep previous data then you will need to find the last row of data and set that as the RNmb