Question

我正在尝试将操作列表转换为Excel VBA中的For循环。

Sheets("Clients").Select 
Range("A7").Select
Selection.Copy 
Sheets("DB TEMP").Select 
Range("A2:A13").Select
ActiveSheet.Paste
Sheets("Clients").Select
Range("B7,D7,F7,H7,J7,L7,N7,P7,R7,T7,V7,X7").Select
Selection.Copy
Sheets("DB TEMP").Select
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

想象一下，你必须这样做x次，我开始考虑创建一个For循环，也许就像在Python中一样简单。

这是我现在的代码（不起作用）

Dim Cellule As Range
Dim Feuille As Worksheet

Sheets("Clients").Select

For Each Cellule In Range("A1:A260")         'For all cells in the column A

    If Cellule <> "" Then         '#if the cell is not null
        Cellule.Select            '#select the cell (if possible to select the adjacent one too in B
        Selection.Copy            '#copy it 
        Sheets("DB TEMP").Select  '#go to other sheets
        With Sheets("DB TEMP")    '#go find the last row available in column A        
            LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        End With
        ActiveSheet.Paste         '#paste the data   

        Sheets("Clients").Select  '#Back in my main sheets



        Range(Cells(Cellule.ActiveCell.Row, B), Cells(Cellule.ActiveCell.Row, D), Cells(Cellule.ActiveCell.Row, F), Cells(Cellule.ActiveCell.Row, H), Cells(Cellule.ActiveCell.Row, J), Cells(Cellule.ActiveCell.Row, L), Cells(Cellule.ActiveCell.Row, N), Cells(Cellule.ActiveCell.Row, P), Cells(Cellule.ActiveCell.Row, R), Cells(Cellule.ActiveCell.Row, T), Cells(Cellule.ActiveCell.Row, V), Cells(Cellule.ActiveCell.Row, X)).Select



            Selection.Copy
            Sheets("DB TEMP").Select
        With Sheets("DB TEMP")
            LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
        End With
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True


    End If

范围（Cell（Cellule.ActiveCell.Row，B）....此行应该选择具有相同行号的所有单元格（Cellule先前）

使用Sheets（“DB TEMP”）....与另一个相同的东西我想将它粘贴到其他工作表并从最后一行转置它。

我认为我在Range选择中有错误，以及如何告诉excel我的行是相同的数字。

当我尝试运行For循环的唯一第一部分时，我只将最后一个非空数据粘贴到其他工作表上（即使我看到excel在过程中检查每一个，也会检查其他数据）

提前感谢您提供任何线索！

Answer 1

如果您想使用选择：

Sheets("DB TEMP").Range("A" & .Rows.Count).End(xlUp).Select
Selection.PasteSpecial

因为看起来你实际上并没有告诉它粘贴的位置。

或者如果您想找到LastRow

Sheets("DB TEMP").Cells(LastRow, 1).PasteSpecial

如果您的问题是cellule.select，请尝试：

selectRow = Cellule.Row
Sheets("NameOfYourSheet").Range("A" & selectRow).Copy

Answer 2

Private Sub cmdTransferer_Click()

    Dim lgLigFinC As Long
    Dim lgLigFinT As Long
    Dim lgLigFinT2 As Long
    Dim CNV As Range


   'For each cell in the column A
   For Each CNV In Sheets("Clients Test v2").Range("A2:A230")

   'If cell is none empty then select it
    If CNV <> "" Then
       CNV.Select

   'Start a boucle to copy my lines 12 times (I am pretty sure there is an easyer way)
    For i = 1 To 12

    'Last empty line in my Location to paste (column A)
    lgLigFinT = Worksheets("DB Temp V2").Range("A" & Cells.Rows.Count).End(xlUp).Row + 1

    ' Copy my data of the active cell to the first empty line of my paste location
    Worksheets("Clients Test v2").Range("A" & ActiveCell.Row).Copy Destination:=Worksheets("DB Temp V2").Range("A" & lgLigFinT)
    Next


' Copy my column data and transpose it (careful if your cell is empty it will not match the precedent copy paste
lgLigFinT2 = Worksheets("DB Temp V2").Range("F" & Cells.Rows.Count).End(xlUp).Row + 1
    Worksheets("Clients Test v2").Application.Union(Range("E" & ActiveCell.Row), Range("G" & ActiveCell.Row), Range("I" & ActiveCell.Row), Range("K" & ActiveCell.Row), Range("M" & ActiveCell.Row), Range("O" & ActiveCell.Row), Range("Q" & ActiveCell.Row), Range("S" & ActiveCell.Row), Range("U" & ActiveCell.Row), Range("W" & ActiveCell.Row), Range("Y" & ActiveCell.Row), Range("AA" & ActiveCell.Row)).Copy
    Worksheets("DB Temp V2").Range("F" & lgLigFinT2).PasteSpecial Transpose:=True

    End If
Next

  End Sub

我很确定某些元素有一个简单的方法，但它对我有用！感谢您的提示我已经选择了一些，所以我将为Hessr17投票。

对于具有多变量的循环

2 个答案: