Forum Discussion
Using VBA to take the data from a column and space it out into a row with 4 empty cells in between
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
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- Got it to work, thanks!
Good to hear that, thanks for the feedback.
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 WithWhy did you change Sub ... and End Sub to With ... and End With? I'm afraid that makes no sense.
Because the Sub didn't work. I entered this new sub code after the rest of my other code needed so there is a line between them. It generated a report with no error, but it didn't pull column C it just did the code I have in the beginning.
Sub 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 Sub
