VBA Code: copy cells individually in a range & paste to the designated cells in other sheets & loop

[alice128]

Hi, I'm a complete beginner when it comes to VBA code writing & would appreciate your help!
A lil bit of context:

• In Sheet 0, there's range F5:F1000* ,which I'd like to copy cell by cell (refer to the next section for a deeper explanation)
  • *However, instead of F1000 I would like to get the last non-blank row in the "F" column (I saw that "Range("A1").End(xlDown).Row" could be used to indicate this, however I wasn't too sure on how to incorporate this into a code, given that I want my range to start from F5) ... will indicate as F5:F* for now.
• In Sheets 1-6 (more to be added): there are a few cell destinations that I'd like for values to be pasted into: "A1", "A10", "I1", "I10", "P1", "P10", "X1", "X10", "AE1", "AE10", "AM1", "AM10"

My Goal:
I would like for the VBA code to go down the list and copy cell values individually from the Sheet 0 F5:F* range, then paste the said value into the designated cells of Sheets 1-6, respectively.
Example:
Copy "F5" from Sheet("0"), Range "F5:F*", then paste "F5" into Sheet("1"), Range("A1"). Then get value "F6" from Sheet("0"), Range "F5:F*", then paste into Sheet("1"), Range ("A10"). Next, Copy "F7" from Sheet("0"), Range "F5:F*", then paste into Sheet ("1"), Range ("I1"). etc. Then once the rest of the respective cells are copied into their "P10", "X1", "X10", "AE1", "AE10", "AM1", "AM10" destinations, the cells continue to be copied from Sheet("0"), Range F5:F* & pasted into the same destination cells in Sheet 2, then once Sheet 2's done, Sheet 3, and so forth.

I was thinking that maybe a loop could by used? to go down the list and copy the next cell in the Sheet 0, F5:F* range & to paste into the next destination cell/sheet (Sheet1-6, "A1", "A10", "I1", "I10", "P1", "P10", "X1", "X10", "AE1", "AE10", "AM1", "AM10").

This code is unfortunately much too complicated and beyond my skill level; so if anyone could help me out with the coding, that'd be super super awesome & amazing .

 

[sericom]

So is there only one row of data per sheet? If so, 6 sheets will hold 72 values, then do you want extra sheets to be created for more data?

 

[Skyybot]

You have 12 values that need to be pasted into new sheets? So Sheets0 F5:F17 go to sheet1 (cells specified), Sheet0 F18:F30 go to Sheet2 (cell specified), and so forth?

 

[alice128]

So is there only one row of data per sheet? If so, 6 sheets will hold 72 values, then do you want extra sheets to be created for more data?

yes, precisely! I want the first 12 rows of data to inputted into sheet 1's "A1", "A10", "I1", "I10", "P1", "P10", "X1", "X10", "AE1", "AE10", "AM1", "AM10", respectively (with the first rows data going into A1 then second row's into A10, etc), then the next 12 rows of data to be inputted into sheet 2s' set, etc.

Also, it'd be nice for new sheets to be made, but if it's too complicated then this part does not need to be included !

 

[alice128]

You have 12 values that need to be pasted into new sheets? So Sheets0 F5:F17 go to sheet1 (cells specified), Sheet0 F18:F30 go to Sheet2 (cell specified), and so forth?

yes! I created the first 6 sheets for now & an planning to create more since the list in Sheet 0 is over 100 rows :,)!

 

[sericom]

This should do the job for you. Your main data sheet needs to be named "Sheet 0", and the code will auto add sheets as required.

Dim cellRng(1 To 12) As Range

Private Sub copyDataToSheets()
    currentDestinationSheet = 1
    setRanges (currentDestinationSheet)
    currentRow = 1
    lastRow = Sheets("Sheet 0").Range("F" & Rows.Count).End(xlUp).Row
    For Each c In Sheets("Sheet 0").Range("F5:F" & lastRow)
         cellRng(currentRow).Value = c.Value
         currentRow = currentRow + 1
         If currentRow > 12 Then
            currentRow = 1
            currentDestinationSheet = currentDestinationSheet + 1
            setRanges (currentDestinationSheet)
         End If
    Next
End Sub

Private Sub setRanges(ws)
    If Not sheetExist("Sheet " & ws) Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Sheet " & ws
    End If
    With Sheets("Sheet " & ws)
        Set cellRng(1) = .Range("A1"):    Set cellRng(2) = .Range("A10")
        Set cellRng(3) = .Range("I1"):    Set cellRng(4) = .Range("I10")
        Set cellRng(5) = .Range("P1"):    Set cellRng(6) = .Range("P10")
        Set cellRng(7) = .Range("X1"):    Set cellRng(8) = .Range("X10")
        Set cellRng(9) = .Range("AE1"):   Set cellRng(10) = .Range("AE10")
        Set cellRng(11) = .Range("AM1"):  Set cellRng(12) = .Range("AM10")
    End With
End Sub

Function sheetExist(sSheet As String) As Boolean
    On Error Resume Next
    sheetExist = (ActiveWorkbook.Sheets(sSheet).Index > 0)
End Function

 

[alice128]

This should do the job for you. Your main data sheet needs to be named "Sheet 0", and the code will auto add sheets as required.

Dim cellRng(1 To 12) As Range

Private Sub copyDataToSheets()
    currentDestinationSheet = 1
    setRanges (currentDestinationSheet)
    currentRow = 1
    lastRow = Sheets("Sheet 0").Range("F" & Rows.Count).End(xlUp).Row
    For Each c In Sheets("Sheet 0").Range("F5:F" & lastRow)
         cellRng(currentRow).Value = c.Value
         currentRow = currentRow + 1
         If currentRow > 12 Then
            currentRow = 1
            currentDestinationSheet = currentDestinationSheet + 1
            setRanges (currentDestinationSheet)
         End If
    Next
End Sub

Private Sub setRanges(ws)
    If Not sheetExist("Sheet " & ws) Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Sheet " & ws
    End If
    With Sheets("Sheet " & ws)
        Set cellRng(1) = .Range("A1"):    Set cellRng(2) = .Range("A10")
        Set cellRng(3) = .Range("I1"):    Set cellRng(4) = .Range("I10")
        Set cellRng(5) = .Range("P1"):    Set cellRng(6) = .Range("P10")
        Set cellRng(7) = .Range("X1"):    Set cellRng(8) = .Range("X10")
        Set cellRng(9) = .Range("AE1"):   Set cellRng(10) = .Range("AE10")
        Set cellRng(11) = .Range("AM1"):  Set cellRng(12) = .Range("AM10")
    End With
End Sub

Function sheetExist(sSheet As String) As Boolean
    On Error Resume Next
    sheetExist = (ActiveWorkbook.Sheets(sSheet).Index > 0)
End Function

Thank you so much for your response! I ran the code & got a "Compile Error: Expected End Sub" notice - do you know what could be causing this error? Thanks in advance .

 

[alice128]

Thank you so much for your response! I ran the code & got a "Compile Error: Expected End Sub" notice - do you know what could be causing this error? Thanks in advance .

I tried moving

This should do the job for you. Your main data sheet needs to be named "Sheet 0", and the code will auto add sheets as required.

Dim cellRng(1 To 12) As Range

Private Sub copyDataToSheets()
    currentDestinationSheet = 1
    setRanges (currentDestinationSheet)
    currentRow = 1
    lastRow = Sheets("Sheet 0").Range("F" & Rows.Count).End(xlUp).Row
    For Each c In Sheets("Sheet 0").Range("F5:F" & lastRow)
         cellRng(currentRow).Value = c.Value
         currentRow = currentRow + 1
         If currentRow > 12 Then
            currentRow = 1
            currentDestinationSheet = currentDestinationSheet + 1
            setRanges (currentDestinationSheet)
         End If
    Next
End Sub

Private Sub setRanges(ws)
    If Not sheetExist("Sheet " & ws) Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Sheet " & ws
    End If
    With Sheets("Sheet " & ws)
        Set cellRng(1) = .Range("A1"):    Set cellRng(2) = .Range("A10")
        Set cellRng(3) = .Range("I1"):    Set cellRng(4) = .Range("I10")
        Set cellRng(5) = .Range("P1"):    Set cellRng(6) = .Range("P10")
        Set cellRng(7) = .Range("X1"):    Set cellRng(8) = .Range("X10")
        Set cellRng(9) = .Range("AE1"):   Set cellRng(10) = .Range("AE10")
        Set cellRng(11) = .Range("AM1"):  Set cellRng(12) = .Range("AM10")
    End With
End Sub

Function sheetExist(sSheet As String) As Boolean
    On Error Resume Next
    sheetExist = (ActiveWorkbook.Sheets(sSheet).Index > 0)
End Function

I tried moving the "Dim cellRng(1 To 12) As Range" line below the private subs because of the "Compile Error: Expected End Sub" & the code ran till it got to the "cellRng(currentRow).Value = c.Value" line at which an "Object variable or With block variable not set" error appeared for the "cellRng(currentRow).Value" portion. Do you know what could be causing this error? :,)

 

[sericom]

Can you show all your code,.

 

[alice128]

Can you show all your code,.

I tried running the code again but after the Dim line & it worked! Sorry about the confusion & thank you so much for your help! )