遍历行以从多个列复制数据

Question

我有一个从供应商表导入数据的工作簿。
供应商工作表A列是动态的。
导入文件应将适当的数据复制到工作簿中的输入表中，以便在将数据传输到日志之前对其进行验证。

循环遍历A列中的所有行以查找特定值。找到后，我使用OFFSET函数从同一行的不同列复制数据。它们不是连续的列。

当从一列复制数据时，代码工作。

当我尝试从每个列复制数据时，它没有返回任何内容。

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

Answer 1

这是您的代码，添加了额外的内容，为每个新数据行增加导入表上的行数，以及避免复制粘贴功能。

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

请注意，每次运行此脚本时，它都会从指定的行号覆盖导入表上当前的任何数据。如果要保留以前的数据，则需要找到最后一行数据，并将其设置为人民币