VBA需要嵌套循环才能移动列 [英] VBA Need a Nested Loop to shift columns

问题描述

对VBA的编码不是很有经验，但是对此事有任何帮助，我将不胜感激.下面的代码运行正常；但是从逻辑上讲，我认为它可以写得更好.有人有建议吗?

Not very experienced with coding VBA, but I would appreciate any help this matter. The code below runs fine; however logically, I feel like it could be written better. Anyone have suggestions?

Sub CopyValues()

  'Declare variables
   Dim Sourcedataws As Worksheet
   Dim WStotransfer As Worksheet

  'Declare counter variables
   Dim i As Integer
   Dim lastrow As Long

  'Declare sheet variables
   Set Sourcedataws = ThisWorkbook.Sheets("Source Data")
   Set WStotransferws = ThisWorkbook.Sheets("WStotransfer")

    lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

  For i = 2 To lastrow

If Sourcedataws.Range("AA" & i).Value = "Condition" Then

    WStotransferws.Range("C18") = Sourcedataws.Range("A" & i).Value
    ActiveCell.Offset(0, 1).Select
    WStotransferws.Range("D18") = Sourcedataws.Range("A" & i).Value
    ActiveCell.Offset(0, 1).Select
    WStotransferws.Range("E18") = Sourcedataws.Range("A" & i).Value
    ActiveCell.Offset(0, 1).Select
    WStotransferws.Range("F18") = Sourcedataws.Range("A" & i).Value
    ActiveCell.Offset(0, 1).Select
    WStotransferws.Range("G18") = Sourcedataws.Range("A" & i).Value
    ActiveCell.Offset(0, 1).Select
    WStotransferws.Range("H18") = Sourcedataws.Range("A" & i).Value
    ActiveCell.Offset(0, 1).Select
    WStotransferws.Range("I18") = Sourcedataws.Range("A" & i).Value



End If

Next

End Sub

推荐答案

尝试:

Sub CopyValues()

'Declare counter variables
Dim i As Integer, j as Integer, lastrow As Long
'Declare variables
Dim Sourcedataws As Worksheet, WStotransfer As Worksheet
'Declare sheet variables
Set Sourcedataws = ThisWorkbook.Sheets("Source Data")
Set WStotransferws = ThisWorkbook.Sheets("WStotransfer")

lastrow = Sourcedataws.Cells(Sourcedataws.Rows.Count, "A").End(xlUp).Row

WStotransferws.Range("C18:I18").ClearContents

For i = 2 To lastrow
    If WStotransferws.Range("I18").Value="" Then
        If Sourcedataws.Range("AA" & i).Value = "Condition" Then
            Sourcedataws.Range("A"&i).Copy 
            j=WStotransferws.Cells(18, WStotransferws.Columns.Count).End(xlToLeft).Column
            WStotransferws.Cells(18,j+1).PasteSpecial xlPasteValues
            End If
        Else
        End If
    Next i

End Sub

这篇关于VBA需要嵌套循环才能移动列的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！