简体   繁体   中英

Move row to worksheet with a variable name

I am attempting to move the entire row in a worksheet to a different worksheet whose name will change as it is looped through. If temp1 (the data in the Master sheet) is equal to temp2 (the data in the DCM sheet) then it will either create a worksheet with the common name, or if the worksheet already exists, it will copy the entire row from the Master worksheet to the new (or already existed) worksheet. Here is my code. I am getting a "Subscript out of range" error at this line:

ActiveWorkbook.Sheets("Master").Cells(i, 1).EntireRow.Copy _
                        Destination:=Worksheets(" & temp2 & ").Range("A" & Rows.Count).End(xlUp).Offset(1)

Private Sub AddtoWorksheet()
Dim temp1 As String
Dim temp2 As String
Dim i As Integer
Dim x As Integer
Dim RowsUsed As Long
Dim RowsUsed2 As Long

 RowsUsed = ActiveWorkbook.Sheets("Master").UsedRange.Rows.Count
 RowsUsed2 = ActiveWorkbook.Sheets("DCM").UsedRange.Rows.Count

 For i = 2 To RowsUsed
    temp1 = ActiveWorkbook.Sheets("Master").Cells(i, 1).Value
        For x = 1 To RowsUsed2
            temp2 = ActiveWorkbook.Sheets("DCM").Cells(x, 1).Value
            If temp1 = temp2 Then
            AddSheetIfMissing (ActiveWorkbook.Sheets("DCM").Cells(i, 1).Value)
            ActiveWorkbook.Sheets("Master").Cells(i, 1).EntireRow.Copy _
                        Destination:=Worksheets(" & temp2 & ").Range("A" & Rows.Count).End(xlUp).Offset(1)
            Else:
            End If
            Next x

        Next i
End Sub

Function AddSheetIfMissing(Name As String) As Worksheet

    On Error Resume Next
    Set AddSheetIfMissing = ThisWorkbook.Worksheets(Name)
    If AddSheetIfMissing Is Nothing Then
        Set AddSheetIfMissing = ThisWorkbook.Worksheets.Add
        AddSheetIfMissing.Name = Name
    End If

End Function

Look at this solution. It addresses a few issues and might simplify what you are trying to do, or at least give you some ideas for new ways to approach this.

Some notes:

  • You should use Long instead of Integer for your loops.

  • If the sheets are all in the same workbook, you don't have to declare "ActiveWorkbook.Sheets"

  • You were attempting to concatenate a variable string with nothing else inside the definition of your destination. '( & temp2 & )'. You only need to do that when creating strings, but since temp1, and temp2 are both strings already, and in variable form, you don't need to do that. Also, they are the same value at that point IF they are being used, so either will work in that line.

  • You don't need to include an Else statement if you are not going to write one.

  • The line below is referring to row i, but DCM isn't on row i at the time, it's on row x, you will be grabbing the wrong sheet name. You have just matched Master(i) with DCM(x) and are using the value of DCM(i) which is somewhere else on the sheet, not being dealt with. Furthermore on that line, since you are really just passing a value through, aren't you trying to pass temp1 / temp2 which is already has that value?

above reference:

AddSheetIfMissing (ActiveWorkbook.Sheets("DCM").Cells(i, 1).Value)
  • You can set the values with a loop through the columns instead of copying a row, which helps avoiding select statements. This is just another way of doing it. It's my preferred way to copy a row, giving me more control to skip certain values if I need to.

Loop example for copying an entire row from one sheet to another.

For lCol = 1 to lastCol
    Sheets(sheet2).Cells(tRow, lCol) = Sheets(sheet1).Cells(lRow, lCol)
Next lCol

Consider this solution:

Private Sub AddtoWorksheet()
Dim temp1 As String, temp2 As String
Dim i As Long, x As Long, tRow As Long
Dim lastRow1 As Long, lastRow2 As Long, lastCol As Long
Dim Sheet1 As String, Sheet2 As String, tempSheet As String
Dim isNew As Boolean

'Define your sheet names
Sheet1 = "Master"
Sheet2 = "DCM"

'Get last row for each sheet
lastRow1 = Sheets(Sheet1).Range("A" & Rows.count).End(xlUp).row
lastRow2 = Sheets(Sheet2).Range("A" & Rows.count).End(xlUp).row

For i = 2 To lastRow1
    temp1 = Sheets(Sheet1).Cells(i, 1).Value
    For x = 1 To lastRow2
        temp2 = Sheets(Sheet2).Cells(x, 1).Value
        If temp1 = temp2 Then

'           AddSheetIfMissing (ActiveWorkbook.Sheets("DCM").Cells(i, 1).Value)
            isNew = AddSheetIfMissing(temp1)

            'Grab the last column number from Master sheet
            lastCol = Sheets(Sheet1).Cells(1, Columns.count).End(xlToLeft).column

            'Set the row on the new sheet
            If isNew = True Then
                tRow = 1
            Else
                tRow = Sheets(temp1).Range("A" & Rows.count).End(xlUp).row + 1
            End If

'           ActiveWorkbook.Sheets("Master").Cells(i, 1).EntireRow.Copy _
'               Destination:=Worksheets(" & temp2 & ").Range("A" & Rows.count).End(xlUp).Offset(1)
            For lCol = 1 To lastCol
                Sheets(temp1).Cells(tRow, lCol).Value = Sheets(Sheet1).Cells(i, lCol).Value
            Next lCol
        End If
    Next x
Next i

End Sub

Function returning boolean test that brings True if the sheet was New. False if not.

Function AddSheetIfMissing(tempName As String) As Boolean
Dim ws As Worksheet
Dim isNew As Boolean
isNew = False
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(tempName)
    If ws Is Nothing Then
        Set ws = ThisWorkbook.Worksheets.Add
        ws.name = tempName
        isNew = True
    End If
AddSheetIfMissing = isNew
End Function

The function you had was set to return a Worksheet, yet on your original code, you had nothing actually grabbing that variable, so it's not needed. I am having it return a test to see if the sheet was new or not, to help determine the row where the data needs to be moved.

Check out this link that better explains the difference between subs and functions .
The simplified summary of that is that they both DO things, but Functions RETURN a value.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM