Excel VBA Macro to copy and paste data from one sheet and paste into different sheets based on cell values on first sheet

tigerstewx

New Member
Joined
Jun 28, 2020
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hi all,

I was trying to put together a macro to copy certain cell values on "Sheet 1" to different sheets in the same workbook based on the cell values in column B.

Basically, column B allows the user to enter the name of the worksheet to which the data should be pasted. I then want to copy the data in that same row in column D and columns E:S and paste it in the relevant worksheet based on the cell value in column B.

When pasting the data, I want the macro to find the next blank row before pasting. The data in column D from Sheet 1 should be pasted in Column B in the destination sheet and columns E:S should be pasted in Columns E:S in the destination as well.

I want the macro to keep looping through all the rows in Sheet 1 until there is a blank cell in column B and therefore no more data to copy and paste. The first cell with data is B5 on Sheet 1.

Please let me know if that isn't clear. Thank you all so much! I have been struggling with this for quite some time now.

Thanks again!
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
I think your logic should look like this:

1. Use a variable to keep the row number on your source sheet.
2. Get destination sheet name from column B from that row
3. Find the last row in the destination sheet by either using a loop counter, or using something like Selection.SpecialCells(xlCellTypeLastCell).Select
4. Select and move the data from source sheet to destination sheet.
5. Increment your counter and repeat using a DO...LOOP until the cell in the row you're on is blank.
 
Upvote 0
Try:
VBA Code:
Sub copydata()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, ws As Range
    Set srcWS = Sheets("Sheet1")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each ws In srcWS.Range("B5:B" & LastRow)
        With Sheets(ws.Value)
            .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = ws.Offset(, 2)
            .Cells(.Rows.Count, "E").End(xlUp).Offset(1).Resize(, 15).Value = ws.Offset(, 3).Resize(, 15).Value
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Try:
VBA Code:
Sub copydata()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, ws As Range
    Set srcWS = Sheets("Sheet1")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each ws In srcWS.Range("B5:B" & LastRow)
        With Sheets(ws.Value)
            .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = ws.Offset(, 2)
            .Cells(.Rows.Count, "E").End(xlUp).Offset(1).Resize(, 15).Value = ws.Offset(, 3).Resize(, 15).Value
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub

Thanks for your help. I tried the code but got a run-time error 9: Subscript out of range. I have some information in column A of Sheet 1 which I want the macro to ignore. I want to set the last row only from Column B. Is that the reason for the runtime error?
 
Upvote 0
Try:
VBA Code:
Sub copydata()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, ws As Range
    Set srcWS = Sheets("Sheet1")
    LastRow = srcWS.Range("B" & srcWS.Rows.Count).End(xlUp).Row
    For Each ws In srcWS.Range("B5:B" & LastRow)
        With Sheets(ws.Value)
            .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = ws.Offset(, 2)
            .Cells(.Rows.Count, "E").End(xlUp).Offset(1).Resize(, 15).Value = ws.Offset(, 3).Resize(, 15).Value
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,506
Messages
6,114,025
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top