How To Copy/Paste Partial Row

Logit · #1 04-24-2021, 07:15 AM

The following macro does everything it is designed for, EXCEPT the copy/paste portion. I am at a loss what correction/s to make.

The macro searches each sheet, specific column (either F or G), seeking any value greater than ZERO. If found, it should copy Cols B:F or B:G (depending on which column was searched) and paste those values to the appropriate worksheet.

Thank you for your assistance !

Code:

Option Explicit

Sub SampleCopy()
Dim ws As Worksheet
Dim c As Range
    
'On Error Resume Next

Application.ScreenUpdating = False

For Each ws In Worksheets
           
    Select Case ws.Name
        
        Case "In Stock", "To Order", "Sheet1"
            'If it's one of these sheets, do nothing
           
        Case Else
            
               For Each c In Range("F15:F" & Cells(Rows.Count, 6).End(xlUp).Row)
                  If c.Value >= 1 Then
                       Range("B:G").Copy Sheets("In Stock").Cells(Rows.Count, 2).End(xlUp)(1)  'Edit sheet name
                  End If
               Next c
            
               For Each c In Range("G15:G50" & Cells(Rows.Count, 7).End(xlUp).Row)
                   If c.Value >= 1 Then
                       Range("B:G").Copy Sheets("To Order").Cells(Rows.Count, 2).End(xlUp)(1)  'Edit sheet name
                   End If
               Next c
          
        End Select
    Next ws
End Sub

Download workbook :
https://www.amazon.com/clouddrive/sh...NbAeIVtC1Vuvld

gibra · #2 04-24-2021, 10:03 AM

You must always indicate the sheet you intend to work on.
This instruction, does NOT select the range as you think, because it reads the active sheet which is not TCU but is Sheet1.

Code:

For Each c In Range("F15:F" & Cells(Rows.Count, 6).End(xlUp).Row)

so you should be write:

Code:

For Each c In ws.Range("F15:F" & Cells(ws.Rows.Count, 6).End(xlUp).Row)

and so on...

Logit · #3 04-24-2021, 11:49 AM

No success. I believe my entire approach to this goal is flawed ???

I receive this error : attach

gibra · #4 04-24-2021, 10:04 PM

I don't know how you modified the code.
Attach the new modified file.

Logit · #5 04-24-2021, 10:28 PM

As you can see I've tried another macro as well. The new macro actually appears to be copying and pasting something but I haven't been able to confirm exactly what because no data is appearing ?

I know, that sounds really stupid but it is going through the steps.

gibra · #6 04-25-2021, 02:43 AM

I honestly don't understand what you are trying to do, and why you want to paste the data into the Sheet1 sheet.

Your error is that you paste an entire row into a single cell.

It would seem that it is enough to remove EntireRow from the instruction, that is:

Code:

c.Copy Destination: = ws1.Cells (x, "B")

but the result is so strange that I doubt it is the desired one.

Logit · #7 04-25-2021, 08:22 AM

Thank you so much for assisting. Here is the answer I've been seeking, provided for others:

Code:

Option Explicit

Sub SampleCopy()
Dim ws As Worksheet
Dim c As Range, rngToCopy As Range
    
'On Error Resume Next

Application.ScreenUpdating = False

For Each ws In Worksheets
           
    Select Case ws.Name
        
        Case "In Stock", "To Order", "Sheet1"
            'If it's one of these sheets, do nothing
           
        Case Else
                
               For Each c In ws.Range("F15:F" & ws.Cells(Rows.Count, 6).End(xlUp).Row)
                  If c.Value > 0 Then
                       Set rngToCopy = Intersect(ws.Columns("B:G"), c.EntireRow)
                       If Not rngToCopy Is Nothing Then
                            rngToCopy.Copy Sheets("In Stock").Cells(Rows.Count, 2).End(xlUp)(2).Resize(, rngToCopy.Columns.Count) 'Edit sheet name
                       End If
                  End If
               Next c
            
               For Each c In ws.Range("G15:G" & ws.Cells(Rows.Count, 7).End(xlUp).Row)
                   If c.Value > 0 Then
                       Set rngToCopy = Intersect(ws.Columns("B:G"), c.EntireRow)
                       If Not rngToCopy Is Nothing Then
                            rngToCopy.Copy Sheets("To Order").Cells(Rows.Count, 2).End(xlUp)(2).Resize(, rngToCopy.Columns.Count)  'Edit sheet name
                       End If
                   End If
               Next c
          
        End Select
    Next ws

    Application.ScreenUpdating = True
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
cut/copy and paste won't paste	DennisWG	Word	1	03-13-2020 12:36 PM
VBA copy/paste	Urraco	Excel Programming	3	05-14-2018 03:59 AM
When I copy&paste a second copy appears that can't be edited	makeo22	Word	3	04-26-2017 07:09 PM
Copy n Paste	seimeinokigen	Excel	2	04-16-2016 09:31 AM
Paste Special: Copy and Paste Formatting Only?	tinfanide	Word	6	03-06-2013 12:21 AM