Forum Discussion

JennaSmith495's avatar
JennaSmith495
Copper Contributor
Sep 13, 2021
Solved

Using VBA to take the data from a column and space it out into a row with 4 empty cells in between

I am trying to write code in VBA to take a column of data from one sheet and move it to one row in another sheet, but I also want there to be four empty cells in between each value in the row. The column of data won't always be the same number of data to take, so I'd like it to work for any amount of data in that column. Does anyone know how to write code for this?

 

For example, column C of values in sheet 1, not including the header, needs to be moved to E2, J2, O2 and so on in sheet 2 for however many results are in column C.

Macros and VBA
  • HansVogelaar's avatar
    HansVogelaar
    Sep 13, 2021

    JennaSmith495 

    Here you go. Modify the constants at the beginning for your setup.

    Sub CopyAndSpace()
    ' Change the following as needed
    Const SourceSheet = "Sheet1"
    Const FirstSourceRow = 1
    Const SourceCol = "C"
    Const TargetSheet = "Sheet2"
    Const TargetRow = 2
    Const Interval = 5
    ' Variables
    Dim WSource As Worksheet
    Dim WTarget As Worksheet
    Dim SourceRow As Long
    Dim LastSourceRow As Long
    Dim TargetCol As Long
    ' Code to copy cells
    Application.ScreenUpdating = False
    Set WSource = Worksheets(SourceSheet)
    Set WTarget = Worksheets(TargetSheet)
    LastSourceRow = WSource.Cells(WSource.Rows.Count, SourceCol).End(xlUp).Row
    For SourceRow = FirstSourceRow To LastSourceRow
        TargetCol = TargetCol + Interval
        WTarget.Cells(TargetRow, TargetCol).Value = WSource.Cells(SourceRow, SourceCol).Value
    Next SourceRow
    Application.ScreenUpdating = True
End Sub

7 Replies

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Sep 13, 2021

    JennaSmith495 

    Here you go. Modify the constants at the beginning for your setup.

    Sub CopyAndSpace()
    ' Change the following as needed
    Const SourceSheet = "Sheet1"
    Const FirstSourceRow = 1
    Const SourceCol = "C"
    Const TargetSheet = "Sheet2"
    Const TargetRow = 2
    Const Interval = 5
    ' Variables
    Dim WSource As Worksheet
    Dim WTarget As Worksheet
    Dim SourceRow As Long
    Dim LastSourceRow As Long
    Dim TargetCol As Long
    ' Code to copy cells
    Application.ScreenUpdating = False
    Set WSource = Worksheets(SourceSheet)
    Set WTarget = Worksheets(TargetSheet)
    LastSourceRow = WSource.Cells(WSource.Rows.Count, SourceCol).End(xlUp).Row
    For SourceRow = FirstSourceRow To LastSourceRow
        TargetCol = TargetCol + Interval
        WTarget.Cells(TargetRow, TargetCol).Value = WSource.Cells(SourceRow, SourceCol).Value
    Next SourceRow
    Application.ScreenUpdating = True
End Sub
    • JennaSmith495's avatar
      JennaSmith495
      Copper Contributor
      Sep 14, 2021

      HansVogelaar 

      I keep getting "Object doesn't support this property or method" I tried adding as you have above under the rest of my code so it is on it's own sub, but that didn't work so I tried using with and adding it to the rest of my code. This is all very new to me so I'm not sure what I am doing wrong. Here is what I have currently, see anything amiss?

       

      With Worksheets("PFAS Sum").CopyAndSpace()
      Const SourceSheet = "PFAS sample info"
      Const FirstSourceRow = 1
      Const SourceCol = "C"
      Const TargetSheet = "PFAS Sum"
      Const TargetRow = 2
      Const Interval = 5
      Dim WSource As Worksheet
      Dim WTarget As Worksheet
      Dim SourceRow As Long
      Dim LastSourceRow As Long
      Dim TargetCol As Long
      Application.ScreenUpdating = False
      Set WSource = Worksheets(SourceSheet)
      Set WTarget = Worksheets(TargetSheet)
      LastSourceRow = WSource.Cells(WSource.Rows.Count, SourceCol).End(xlUp).Row
      For SourceRow = FirstSourceRow To LastSourceRow
      TargetCol = TargetCol + Interval
      WTarget.Cells(TargetRow, TargetCol).Value = WSource.Cells(SourceRow, SourceCol).Value
      Next SourceRow
      Application.ScreenUpdating = True
      End With

Resources