if cell has a value then copy and paste whats in that cell and to the right of it

[drop05]

Hello, a bit new to this.

1. Using VBA im trying to see if there is a way to check if a cell has a value, in my case cell G52, if it has a value then copy that cell and the cells to the right of it, so G52 H52 I52. . so on until there is a the last value.

2. Those values that are copied, paste them into another sheet/workbook in their landing spot. So say sheet two the first landing spot from the value in G52 will go in cell F163 then the value from H52 will go in cell F174, and the value from I52 will go into cell F185, and so on, basically pasting starting from the first landing spot of 163 and pasting the next value after every 11 cells below that.

3. Now back to part 1, If it does not have a value then skip it and go to the next iteration and do the same as above. The next iteration is about 351 cells below it, so G403, and basically would want it to do the same, if it has a value then copy that cell and everything to the right of it and paste it into the next iteration of sheet two. Now the 2nd iteration of sheet two those would not b F163 instead just replacing the F with G, same concept just different column per iteration

any help would be grateful!

 

[offthelip]

the code is currently picking up the values from the "active sheet" and always writes to "sheet 2" , Certainly the code can be changed to always pick up the data from sheet 1 regardless of which sheet is active, if that is what you want to do.
what exactly do you want??

 

[drop05]

the code is currently picking up the values from the "active sheet" and always writes to "sheet 2" , Certainly the code can be changed to always pick up the data from sheet 1 regardless of which sheet is active, if that is what you want to do.
what exactly do you want??

I am wanting what it is doing now, copy and paste depending on the iteration. But wanting the macro to look at sheet one and get the copy values how it is doing when it is the active one. then pasting into the landing spots in sheet two. Just taking out the active sheet part for now.

I also have other areas i want this to do the same thing. Explaining, the code above is for the area of names (G52, H52 so on)
I used the same code for a different area, addresses,
So changing it from 52 to 53 and 163 to 164 in the code. Is there a way to combined this, or easier just copy paste the code and change the numbers how i did and make different subs for each one

hopfully what i explained makes sense if not i can liberate more if needed
here is what the sheet looks like and you will see areas that match some that sheet 2 has that sheet 1 does not have but it may help visually see what i mean too
the first one is sheet1 where it copies from left to right for name, but would like it to do name, address, etc.

Second one is sheet2 which is the landing areas. I know it skips 11 to paste the next value and it only has for example name 2 times but i have it for the user to say how many, for example, names it will need in that iteration. Ill fill out data too to give a visual of what im looking for in the output

i really appreciate you for you time and help, means a lot and learning a lot as well and understanding more about this language!

 

[offthelip]

to get the code to always pick up sheet 1 regardless which sheet is active use this code:

Sub test()
For i = 0 To 1
With Worksheets("Sheet1")
lastcol = .Cells(52 + i * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Worksheets("Sheet1")
inarr = .Range(.Cells(52 + i * 351, 7), .Cells(52 + i * 351, lastcol))
End With
    If inarr(1, 1) <> "" Then
        With Worksheets("Sheet2")
          For j = 1 To UBound(inarr, 2)
           jj = j - 1
            .Range(.Cells(163 + jj * 11, 6 + i), .Cells(163 + jj * 11, 6 + i)) = inarr(1, j)
           Next j
        End With
    End If
End If
Next i
End Sub

I didn't understand your other requirements , sorry!!

 

[drop05]

to get the code to always pick up sheet 1 regardless which sheet is active use this code:

Sub test()
For i = 0 To 1
With Worksheets("Sheet1")
lastcol = .Cells(52 + i * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Worksheets("Sheet1")
inarr = .Range(.Cells(52 + i * 351, 7), .Cells(52 + i * 351, lastcol))
End With
    If inarr(1, 1) <> "" Then
        With Worksheets("Sheet2")
          For j = 1 To UBound(inarr, 2)
           jj = j - 1
            .Range(.Cells(163 + jj * 11, 6 + i), .Cells(163 + jj * 11, 6 + i)) = inarr(1, j)
           Next j
        End With
    End If
End If
Next i
End Sub

I didn't understand your other requirements , sorry!!

going to run this and test, but wanted to reply so you can see, please do not be sorry you are awesome and super helpful! I am truly grateful for your continued assistance!

 

[drop05]

to get the code to always pick up sheet 1 regardless which sheet is active use this code:

Sub test()
For i = 0 To 1
With Worksheets("Sheet1")
lastcol = .Cells(52 + i * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Worksheets("Sheet1")
inarr = .Range(.Cells(52 + i * 351, 7), .Cells(52 + i * 351, lastcol))
End With
    If inarr(1, 1) <> "" Then
        With Worksheets("Sheet2")
          For j = 1 To UBound(inarr, 2)
           jj = j - 1
            .Range(.Cells(163 + jj * 11, 6 + i), .Cells(163 + jj * 11, 6 + i)) = inarr(1, j)
           Next j
        End With
    End If
End If
Next i
End Sub

I didn't understand your other requirements , soWE

With this code, just curious, is there a way to use it how it is, but the cells copying the user either puts a X or blank on sheet1 and in sheet2 the X pastes as a "Yes" and blank paste as "No". Same processes as above but just if its a X then paste Yes if its "" then paste No

 

[offthelip]

You can sustitute X for Yes and blank for No by changing the code:

          For j = 1 To UBound(inarr, 2)
           jj = j - 1
            .Range(.Cells(163 + jj * 11, 6 + i), .Cells(163 + jj * 11, 6 + i)) = inarr(1, j)
           Next j

to:

         For j = 1 To UBound(inarr, 2)
           jj = j - 1
            if inarr(1,j)="X" then inarr(1,j)="Yes"
            if inarr(1,j)="" then inarr(i,j)="No"
            .Range(.Cells(163 + jj * 11, 6 + i), .Cells(163 + jj * 11, 6 + i)) = inarr(1, j)
           Next j

 

[drop05]

to get the code to always pick up sheet 1 regardless which sheet is active use this code:

Sub test()
For i = 0 To 1
With Worksheets("Sheet1")
lastcol = .Cells(52 + i * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Worksheets("Sheet1")
inarr = .Range(.Cells(52 + i * 351, 7), .Cells(52 + i * 351, lastcol))
End With
    If inarr(1, 1) <> "" Then
        With Worksheets("Sheet2")
          For j = 1 To UBound(inarr, 2)
           jj = j - 1
            .Range(.Cells(163 + jj * 11, 6 + i), .Cells(163 + jj * 11, 6 + i)) = inarr(1, j)
           Next j
        End With
    End If
End If
Next i
End Sub

I didn't understand your other requirements , sorry!!

The other requirement I was trying to say, what if i want two sections of the same code
example:

This brings in the name

Sub name()
For i = 0 To 1
With Worksheets("Sheet1")
lastcol = .Cells(52 + i * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Worksheets("Sheet1")
inarr = .Range(.Cells(52 + i * 351, 7), .Cells(52 + i * 351, lastcol))
End With
If inarr(1, 1) <> "" Then
With Worksheets("Sheet2")
For j = 1 To UBound(inarr, 2)
jj = j - 1
.Range(.Cells(163 + jj * 11, 6 + i), .Cells(163 + jj * 11, 6 + i)) = inarr(1, j)
Next j
End With
End If
End If
Next i
End Sub

This brings in the address

Sub address()
For i = 0 To 1
With Worksheets("Sheet1")
lastcol = .Cells(53 + i * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Worksheets("Sheet1")
inarr = .Range(.Cells(53 + i * 351, 7), .Cells(53 + i * 351, lastcol))
End With
If inarr(1, 1) <> "" Then
With Worksheets("Sheet2")
For j = 1 To UBound(inarr, 2)
jj = j - 1
.Range(.Cells(164 + jj * 11, 6 + i), .Cells(164 + jj * 11, 6 + i)) = inarr(1, j)
Next j
End With
End If
End If
Next i
End Sub

Sub ID()
For i = 0 To 1
With Worksheets("Sheet1")
lastcol = .Cells(54 + i * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Worksheets("Sheet1")
inarr = .Range(.Cells(54 + i * 351, 7), .Cells(54 + i * 351, lastcol))
End With
If inarr(1, 1) <> "" Then
With Worksheets("Sheet2")
For j = 1 To UBound(inarr, 2)
jj = j - 1
.Range(.Cells(165 + jj * 11, 6 + i), .Cells(165 + jj * 11, 6 + i)) = inarr(1, j)
Next j
End With
End If
End If
Next i
End Sub

Noticed how its the same code just changed the 52 to 53 and the 163 to 164 in the second half of the code and so on

Is there a way to put them together without having to do separate subs? As i am considering editing it to have a separate workbook that the user can select the file to copy from and then select the file to paste to, same concept, but just having it do a fileOpen and look for the sheet name to copy from and the sheet name to paste to and i may be wrong but if i have separate subs then ill have to do fileOpen for each one and that will cause the user to have to select the file over and over which id want them to just have to select the two files once and this third file that contains this marco does the code

 

[offthelip]

yes very simple just add another loop index like this:

Sub nameaddid()
For kkk = 0 To 2
For i = 0 To 1
With Worksheets("Sheet1")
lastcol = .Cells(kkk + 52 + i * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Worksheets("Sheet1")
inarr = .Range(.Cells(kkk + 52 + i * 351, 7), .Cells(kkk + 52 + i * 351, lastcol))
End With
If inarr(1, 1) <> "" Then
With Worksheets("Sheet2")
For j = 1 To UBound(inarr, 2)
jj = j - 1
.Range(.Cells(kkk + 163 + jj * 11, 6 + i), .Cells(kkk + 163 + jj * 11, 6 + i)) = inarr(1, j)
Next j
End With
End If
End If
Next i
Next kkk
end sub

you can see the advantages of using number to address row and columns because you can easily calculate row and column numbers. So in VBA I very rarely using letter s to address columns numbers work better in vba

 

[drop05]

You can sustitute X for Yes and blank for No by changing the code:

          For j = 1 To UBound(inarr, 2)
           jj = j - 1
            .Range(.Cells(163 + jj * 11, 6 + i), .Cells(163 + jj * 11, 6 + i)) = inarr(1, j)
           Next j

to:

         For j = 1 To UBound(inarr, 2)
           jj = j - 1
            if inarr(1,j)="X" then inarr(1,j)="Yes"
            if inarr(1,j)="" then inarr(i,j)="No"
            .Range(.Cells(163 + jj * 11, 6 + i), .Cells(163 + jj * 11, 6 + i)) = inarr(1, j)
           Next j

just thought of it, doing the blanks as no will keep pasting no. Example: if i put G52 as X then it will do Yes on F163, but if H52 I52 Etc is just blank because they may not be used. On sheet 1, one iteration of a name can have 100 values, then it goes to the next iteration down below and each iteration has from cells G to DB in sheet 1, is there a work around?

 

[offthelip]

I can't think of an easy solution to changing blank to X, unless you want to limit it to specific addresses. The code does what you asked for!!!

On sheet 1, one iteration of a name can have 100 values, then it goes to the next iteration down below and each iteration has from cells G to DB in sheet 1, is there a work around?

I am not sure what you think is a problem here, you can do 100 iterations just by changing the i loop. It might take slightly longer but there is no reason why it should fail