Excel Looping through rows and copy cell values to another worksheet

后端 未结 1 802
盖世英雄少女心
盖世英雄少女心 2021-01-02 16:37

I am facing some difficulty in achieving the desired result for my macro.

Intention:

I have a list of data in sheets(inpu

相关标签:
1条回答
  • 2021-01-02 17:24
    Private Sub CommandButton1_Click() 
    
    Dim Z As Long 
    Dim Cellidx As Range 
    Dim NextRow As Long 
    Dim Rng As Range 
    Dim SrcWks As Worksheet 
    Dim DataWks As Worksheet 
    Z = 1 
    Set SrcWks = Worksheets("Sheet1") 
    Set DataWks = Worksheets("Sheet2") 
    Set Rng = EntryWks.Range("B6:ad6") 
    
    NextRow = DataWks.UsedRange.Rows.Count 
    NextRow = IIf(NextRow = 1, 1, NextRow + 1) 
    
    For Each RA In Rng.Areas 
        For Each Cellidx In RA 
            Z = Z + 1 
            DataWks.Cells(NextRow, Z) = Cellidx 
        Next Cellidx 
    Next RA 
    End Sub
    

    Alternatively

    Worksheets("Sheet2").Range("P2").Value = Worksheets("Sheet1").Range("L10") 
    

    This is a CopynPaste - Method

    Sub CopyDataToPlan()
    
    Dim LDate As String
    Dim LColumn As Integer
    Dim LFound As Boolean
    
    On Error GoTo Err_Execute
    
    'Retrieve date value to search for
    LDate = Sheets("Rolling Plan").Range("B4").Value
    
    Sheets("Plan").Select
    
    'Start at column B
    LColumn = 2
    LFound = False
    
    While LFound = False
    
      'Encountered blank cell in row 2, terminate search
      If Len(Cells(2, LColumn)) = 0 Then
         MsgBox "No matching date was found."
         Exit Sub
    
      'Found match in row 2
      ElseIf Cells(2, LColumn) = LDate Then
    
         'Select values to copy from "Rolling Plan" sheet
         Sheets("Rolling Plan").Select
         Range("B5:H6").Select
         Selection.Copy
    
         'Paste onto "Plan" sheet
         Sheets("Plan").Select
         Cells(3, LColumn).Select
         Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
         False, Transpose:=False
    
         LFound = True
         MsgBox "The data has been successfully copied."
    
         'Continue searching
          Else
             LColumn = LColumn + 1
          End If
    
       Wend
    
       Exit Sub
    
    Err_Execute:
      MsgBox "An error occurred."
    
    End Sub
    

    And there might be some methods doing that in Excel.

    0 讨论(0)
提交回复
热议问题