انتقال اطلاعات از دوشیت به یک شیت بصورت خاص !

[iranweld]

با سلام

فرضا اگر ستون توضیحات j باشد : Sheets("Home").Range("j" & z2) = 1

Sub test()

za = Sheets("A").Cells(Sheets("A").Rows.Count, "B").End(xlUp).Row

For i = 2 To za

If Sheets("A").Rows(i & ":" & i).EntireRow.Hidden = False Then

z2 = Sheets("Home").Cells(Sheets("Home").Rows.Count, "B").End(xlUp).Row + 1

Sheets("A").Range("B" & i & ":j" & i).Copy Destination:=Sheets("Home").Range("B" & z2)

Sheets("Home").Range("j" & z2) = 1

End If

Next


zb = Sheets("B").Cells(Sheets("B").Rows.Count, "B").End(xlUp).Row

For i = 2 To zb

If Sheets("B").Rows(i & ":" & i).EntireRow.Hidden = False Then

z2 = Sheets("Home").Cells(Sheets("Home").Rows.Count, "B").End(xlUp).Row + 1

Sheets("B").Range("B" & i & ":j" & i).Copy Destination:=Sheets("Home").Range("B" & z2)

Sheets("Home").Range("j" & z2) = 2

End If

Next

End Sub 

[Skynet]

با سلام و احترام
بی نهایت ممنونم بهتر از این نمیشد عالییییی مرسییی