Question

VBA新手。我有一个客户数据excel表，可以在D列中有一个或多个具有相同客户名称的行。我需要将excel表导入到每个客户只允许6行到每个表单的软件中，并且必须有行2 -6列A-BQ和列CI-CU中为空。对于第7行（如果客户有那么多行），它将是一个全新的形式。所以..我想将每个客户的第一个实例的整行复制到另一个选项卡，但是对于同一个客户的下一个5行（如果他们有6个或更多行），我只希望列中的数据通过BR CH复制到完全相同的列位置（BR-CH）中的另一个选项卡。如果客户有7行，我需要复制该客户的第7行。我找到了不同部分的代码，但无法找出正确的组合。请帮忙。这是一些示例数据：https://drive.google.com/file/d/0B-2yq0m7KyerNXV0Q0w4UHJUdm8/view 这是我到目前为止的代码（修订后的代码有效，排序）

 Dim LastRow As Long
   Dim i As Long, j As Long, x As Long

   'Find the last used row in a Column: column A in this example
   With Worksheets("Sheet2")
      LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   End With

   MsgBox (LastRow)
   'first row number where you need to paste values in Sheet1'
   With Worksheets("Sheet1")
      j = .Cells(.Rows.Count, "A").End(xlUp).Row
   End With
   With Worksheets("Sheet2")
Sheets("sheet2").Range("A" & 1 & ":CU" & 1).Copy Destination:=Sheets("sheet1").Range("A" & 1)
End With
   For i = 2 To LastRow
        x = i - 1
          With Worksheets("Sheet2")
          If .Cells(i, "D").Value = .Cells(x, "D").Value And Z < 7 Then
           Z = Z + 1
           Else: Z = 1
           End If
          If .Cells(i, "D").Value = .Cells(x, "D").Value And Z < 7 Then
           Sheets("sheet2").Range("BQ" & i & ":CU" & i).Copy Destination:=Sheets("sheet1").Range("BQ" & i)
          Else: Sheets("sheet2").Range("A" & i & ":CU" & i).Copy Destination:=Sheets("sheet1").Range("A" & i)
               j = j + 1
        End If
          End With
   Next i
End Sub

vb宏条件搜索复制某些列

0 个答案: