Option Explicit
Private Sub krb_Click()
Dim i As Integer
i = 1
While (Not IsEmpty(Cells(i, 1)))
Cells(i, 2) = Workbooks("zrodlo.xlsx").Sheets("Arkusz1").Cells(i, 2)
i = i + 1
Wend
End Sub
'*******************************************************************************
Option Explicit
Private Sub start_Click()
Dim i As Integer
Dim oCon As ADODB.Connection
Dim oRS As ADODB.Recordset
Set oCon = New ADODB.Connection
Set oRS = New ADODB.Recordset
oCon.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\kubar\Documents\Sklep.accdb;Persist Security Info=False;"
oRS.Open "SELECT * FROM Towary", oCon
Range("A3").CopyFromRecordset oRS
For i = 0 To oRS.Fields.Count - 1
Range("A2").Offset(0, i).Value = oRS.Fields(i).Name
Next i
Set oRS = Nothing
oCon.Close
End Sub
'*******************************************************************************
Option Explicit
Private Sub start_Click()
Dim i, k, l As Integer
Range("B1").Select
i = 1
l = 1
While Not IsEmpty(Cells(i, 1))
Sheets("Arkusz2").Cells(i, 1) = Cells(i, 1)
i = i + 1
Wend
For k = 1 To 9
Cells(k, 2) = "pętla for " & k
Next k
MsgBox i & "   " & k
End Sub
'*******************************************************************************
Option Explicit
Private Sub Porownaj_Wspolne_Click()
Dim cCol, sCol, wCol, sArk, co As String
Dim k As Long
Dim fc As Range
cCol = "A" 'Kolumna co poszukiwan w bierzacym arkuszu
wCol = "C" 'Wyniki poszukiwan w bierzacym arkuszu
sArk = "Porownywany" 'Nazwa arkusza do poszukiwan
sCol = "A" 'Kolumna w arkuszu do poszukiwań  'sCol = Split(Cells(, nCol).Address, "$")(1)
Columns(wCol & ":" & wCol).ClearContents
Columns(wCol & ":" & wCol).Font.ColorIndex = xlAutomatic
k = 2
Do While Not IsEmpty(Range(cCol & k))
co = Range(cCol & k)
co = Left(co, 255)
Set fc = Sheets(sArk).Columns(sCol & ":" & sCol).Find(What:=co, LookIn:=xlValues, SearchOrder:=xlByRows, MatchCase:=False, LookAt:=xlPart, SearchFormat:=False)
'SearchFormat:=False LookAt:=xlPart albo SearchFormat:=True, LookAt:=xlWhole - Uwzględnij wielkość liter, Dopasuj do całej zawartości komórki
If fc Is Nothing Then
Range(wCol & k) = "nie ma"
Range(wCol & k).Font.ThemeColor = xlThemeColorAccent2
Else
Range(wCol & k) = fc.Offset(0, 0) 'Znaleziona komórka
Range("B" & k) = fc.Offset(0, 1) 'Przesunięcie w kolumnach od znalezionej komórki
'Range(wCol & k) = fc.Offset(0, 1) 'Przesunięcie w kolumnach od znalezionej komórki
End If
k = k + 1
Loop
MsgBox "Koniec poszukiwan"
End Sub