It is not work "Paste Feature" in my code. by using VBA

Question

I made a code by using Excel VBA. It seems that it can be copied, but it cannot be copied to the new sheet of the newly created file. Continue to a specific row " ' Paste the copied row to the new sheet There is an error in newSheet.Rows(newSheet.Rows.Count + 1).PasteSpecial xlPasteValues", but I can't fix it. Is there anyone who can solve it?

The purpose of the code is: If the word haynes is entered in column f of Excel files collected in a folder, the entire row must be copied and rearranged.

Sub CopyRowsWithHaynes()

' Create a new workbook to store the copied data
Dim newWorkbook As Workbook
Set newWorkbook = Workbooks.Add

' Create a new sheet in the new workbook
Dim newSheet As Worksheet
Set newSheet = newWorkbook.Sheets.Add

' Set the name of the new sheet
newSheet.Name = "Haynes Rows"

' Define the folder to search for Excel files
Dim folderPath As String
folderPath = "C:\Excel Files"

' Get a list of all Excel files in the folder
Dim file As String
file = Dir(folderPath & "\*.xl*")

' Loop through each file in the folder
Do While file <> ""

  ' Open the current Excel file
  Dim sourceWorkbook As Workbook
  Set sourceWorkbook = Workbooks.Open(folderPath & "\" & file)

  ' Loop through each sheet in the workbook
  For Each sourceSheet In sourceWorkbook.Sheets

    ' Find the last row with data in column F
    Dim lastRow As Long
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "F").End(xlUp).Row

    ' Loop through each row in column F
    Dim i As Long
    For i = 1 To lastRow

      ' Check if the current cell in column F starts with the prefix "Haynes"
      If UCase(Left(sourceSheet.Cells(i, "F").Value, 6)) = "HAYNES" Then

        ' Copy the entire row to the new sheet
        sourceSheet.Rows(i).Copy
        
        ' Paste the copied row to the new sheet
        newSheet.Rows(newSheet.Rows.Count + 1).PasteSpecial xlPasteValues

      End If

    Next i

  Next sourceSheet


  ' Get the next file in the folder
  file = Dir()

Loop

' Autofit the columns in the new sheet
newSheet.Columns.AutoFit

End Sub

I couldn't touch anything because I didn't know what the problem was. All I could do was hit the compile button.

`newSheet.Rows.Count` is the number of rows on the sheet, not the number of *occupied* rows. Use a row counter instead, and increment it by 1 each time you copy a row. — Tim Williams, Feb 10 '23 at 08:09
`newSheet.Rows(newSheet.Rows.Count + 1)` . This is looking one row down from the bottom of the sheet, which it can't do. You forgot top add the `.End(xlUp).Row` bit — Darren Bartrup-Cook, Feb 10 '23 at 08:09
Does this answer your question? [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — Dominique, Feb 10 '23 at 09:14

score 0 · Answer 1 · answered Feb 10 '23 at 08:50

I've altered the code to find the last used row on NewSheet and store this in a new variable called LastRowNS. This works the same way as the program finds the last row of the sourceSheet (LastRow). I've also moved the declarations (Dim statements) outside the loops as they only need to be declared once.

Sub CopyRowsWithHaynes()

    ' Create a new workbook to store the copied data
    Dim newWorkbook As Workbook
    Set newWorkbook = Workbooks.Add
    
    ' Create a new sheet in the new workbook
    Dim newSheet As Worksheet
    Set newSheet = newWorkbook.Sheets.Add
    
    ' Set the name of the new sheet
    newSheet.Name = "Haynes Rows"
    
    ' Define the folder to search for Excel files
    Dim folderPath As String
    folderPath = "C:\Excel Files"
    
    ' Get a list of all Excel files in the folder
    Dim file As String
    file = Dir(folderPath & "\*.xl*")
    
    Dim sourceWorkbook As Workbook
    Dim lastRow As Long, lastRowNS As Long
    Dim i As Long
        
    ' Loop through each file in the folder
    Do While file <> ""
    
      ' Open the current Excel file
      Set sourceWorkbook = Workbooks.Open(folderPath & "\" & file)
    
      ' Loop through each sheet in the workbook
      For Each sourceSheet In sourceWorkbook.Sheets
    
        ' Find the last row with data in column F
    
        lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "F").End(xlUp).Row
    
        ' Loop through each row in column F
    
        For i = 1 To lastRow
    
          ' Check if the current cell in column F starts with the prefix "Haynes"
          If UCase(Left(sourceSheet.Cells(i, "F").Value, 6)) = "HAYNES" Then
    
            ' Copy the entire row to the new sheet
            sourceSheet.Rows(i).Copy
            
            'Find last occupied row on newSheet
            lastRowNS = newSheet.Cells(newSheet.Rows.Count, "A").End(xlUp).Row
            
            ' Paste the copied row to the new sheet
            newSheet.Rows(lastRowNS + 1).PasteSpecial xlPasteValues
    
          End If
    
        Next i
    
      Next sourceSheet
     
      ' Get the next file in the folder
      file = Dir()
    
    Loop
    
    ' Autofit the columns in the new sheet
    newSheet.Columns.AutoFit

End Sub

It is not work "Paste Feature" in my code. by using VBA

1 Answers1