Soru Satır Birleştirme

[ayagiz44]

Sub Bul()
Dim x As Long
Dim s1 As Worksheet
On Error Resume Next
Application.ScreenUpdating = False
Set s1 = Sheets("1")
Son1 = Sheets("1").Cells(Rows.Count, "A").End(3).Row
Alan = "b2:ck" & Son1
satır = 2
For x = 2 To Son1
Range("b" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 2, 0)
Range("c" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 3, 0)
Range("d" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 31, 0)
Range("e" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 78, 0)
Range("e" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 44, 0)
satır = satır + 1
Next x
Application.ScreenUpdating = True
End Sub


(B) ve (C) hücresini birleştirip (B) de birleştirsin
Selamlar teşekkürler

 

[metehan8001]

Sub Bul()
Dim x As Long
Dim s1 As Worksheet
On Error Resume Next
Application.ScreenUpdating = False
Set s1 = Sheets("1")
Son1 = Sheets("1").Cells(Rows.Count, "A").End(3).Row
Alan = "b2:ck" & Son1
satır = 2
For x = 2 To Son1
Range("b" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 2, 0)
Range("c" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 3, 0)
Range("d" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 31, 0)
Range("e" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 78, 0)
Range("e" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 44, 0)
satır = satır + 1
Next x
Application.ScreenUpdating = True
End Sub


(B) ve (C) hücresini birleştirip (B) de birleştirsin
Selamlar teşekkürler

Sub Bul()
Dim x As Long
Dim s1 As Worksheet
On Error Resume Next
Application.ScreenUpdating = False
Set s1 = Sheets("1")
Son1 = Sheets("1").Cells(Rows.Count, "A").End(3).Row
Alan = "b2:ck" & Son1
satır = 2
For x = 2 To Son1

BB = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 2, 0)
CC = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 3, 0)
Range("b" & satır) = BB & " " & CC

Range("c" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 3, 0)
Range("d" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 31, 0)
Range("e" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 78, 0)
Range("e" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 44, 0)
satır = satır + 1
Next x
Application.ScreenUpdating = True
End Sub

 

[ayagiz44]

Sub Bul()
Dim x As Long
Dim s1 As Worksheet
On Error Resume Next
Application.ScreenUpdating = False
Set s1 = Sheets("1")
Son1 = Sheets("1").Cells(Rows.Count, "A").End(3).Row
Alan = "b2:ck" & Son1
satır = 2
For x = 2 To Son1
Range("b" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 2, 0)
Range("c" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 3, 0)
Range("d" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 31, 0)
Range("e" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 78, 0)
Range("e" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 44, 0)
satır = satır + 1
Next x
Application.ScreenUpdating = True
End Sub


(B) ve (C) hücresini birleştirip (B) de birleştirsin
Selamlar teşekkürler

TÜŞEKKÜRLER SELAMLAR

 

[Orion1]

Range("e" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 78, 0)
Range("e" & satır) = WorksheetFunction.VLookup(Range("a" & satır), s1.Range(Alan), 44, 0)

Yukarıda 2 kere e sütununa veri yazdırılmış.İlki silinir,2ncisi yazılır daima.

 

[ayagiz44]

DÜZELTTİM HOCAM SAYGILAR